Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
The RRRCUBE
#1
This is my latest attempt at 3d modeling, using the simple3d library.

  This is the first version, and I hope I can end up with a fully functioning cube.

[Image: attachment.php?aid=62]

Code:
   '  By Rick3137    http://rb23.yolasite.com/
   '  You have permission to copy, paste, alter or post anywhere as long as you don't copyright my work.
   '  If it breaks your computer or does damage to your health or wealth , I didn't do it.
   '  You have permission to tranlate to other languages, like Android and copyright that version.

import "Simple3D.lib"
import "Speed.lib"
set redraw off
visible:
  a1 = 0 ; mb = 0 ; a2 = 0
  Angle# = 0.0
   x1;x2;x3;x4;x5;x6;x7;x8;x9;x10;x11;x12;x13;x14;x15;x16;x17;x18;x19;x20;x21;x22;x23;x24;x25;x26;x27;x28;x29;x30;x31;x32;x33;x34;x35;x36;x37;x38;x39
   x40;x41;x42;x43;x44;x45;x46;x47;x48;x49;x50;x51;x52;x53;x54;x55;x56;x57;x58;x59;x60;x61;x62
   y1;y2;y3;y4;y5;y6;y7;y8;y9;y10;y11;y12;y13;y14;y15;y16;y17;y18;y19;y20;y21;y22;y23;y24;y25;y26;y27;y28;y29;y30;y31;y32;y33;y34;y35;y36;y37;y38;y39
   y40;y41;y42;y43;y44;y45;y46;y47;y48;y49;y50;y51;y52;y53;y54;y55;y56;y57;y58;y59;y60;y61;y62

   x63;x64;x65;x66;x67;x68;x69;x70;x71;x72;x73;x74;x75;x76;x77;x78;x79;x80;x81;x82;x83;x84;x85;x86;x87;x88;x89;x90;x91;x92;x93;x94;x95;x96;x97;x98;x99
   y63;y64;y65;y66;y67;y68;y69;y70;y71;y72;y73;y74;y75;y76;y77;y78;y79;y80;y81;y82;y83;y84;y85;y86;y87;y88;y89;y90;y91;y92;y93;y94;y95;y96;y97;y98;y99

   clr[60]
 
hidden:
set window 0,0,1100,750
   
 proc Setup
 proc SetFrame

do
 set color 100, 100, 90
    cls

 proc Input
 set caret 20,20
    set color 255, 255, 255
   write Angle

 proc SetFrame
 proc Cube 1.0, 1.0

 proc DrawPanel
    redraw
 wait 10
 proc SPD_HoldFrame 120
 
until keydown(27, true)
' END PROGRAM

procedure SetFrame()
 proc S3D_ClearTransformation
 proc S3D_SetView 60.0, 0.1, 10.0
    proc S3D_Translate 0.0, -1.0, 20.0
    proc S3D_RotateX 30.0
 proc S3D_RotateY Angle
 proc S3D_Scale 4.0,4.0,4.0


' translate 10.0, 2.0
endproc


procedure Input()

        state = zone(1)
           if state = 2 then    Angle = Angle + 1.0
        state = zone(2)
       if state = 2 then  Angle = Angle - 1.0
    
       if Angle > 360.0 then Angle = 0.0
       if Angle < 0.0 then Angle = 360.0

endproc

procedure Setup()
    proc CreateArrows
    proc SetZones
     set image primary
     set color 255, 255, 255
    ' create font 0, "arial" , 24
    ' set font 0
    for a = 1 to 54
        if a<10 then clr[a] = 1 ; ' white
        if a>45 then clr[a] = 6 ; ' yellow
        if a=10 or a=11 or a=12 or a=22 or a=23 or a=24 or a=34 or a=35 or a=36 then clr[a] = 2 ;  ' red
        if a=13 or a=14 or a=15 or a=25 or a=26 or a=27 or a=37 or a=38 or a=39 then clr[a] = 3 ;  ' blue
        if a=16 or a=17 or a=18 or a=28 or a=29 or a=30 or a=40 or a=41 or a=42 then clr[a] = 4 ;  ' orange
        if a=19 or a=20 or a=21 or a=31 or a=32 or a=33 or a=43 or a=44 or a=45 then clr[a] = 5 ;  ' green

    next
endproc

procedure SetZones()
          create zone 1,10,500, 100, 100
          create zone 2,110,500, 100, 100


endproc

procedure CreateArrows()
   create image 1 ,100,100 ;     create image 2 ,100,100 ;     create image 3 ,100,100 ;     create image 4 ,100,100
   p1[] = [ 25,10,25,60,0,35 ] ; p2[] = [ 74,10,74,60,99,35 ]
   set image 1
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 10, 40, 60
         draw rect 25,20,80,30,1
         draw poly p1,1
         set color 255, 255, 255
         draw rect 25,20,80,30, 0
         draw poly p1,0
   set image 2
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 10, 40, 60
         draw rect 1,20,74,30, 1
         draw poly p2,1
        set color 255, 255, 255
         draw rect 1,20,74,30, 0
         draw poly p2,0


   set image 3
         draw rect 1,20,80,30, 1

   set image 4
         draw rect 1,20,80,30, 1

   set image primary
     set color 255, 255, 255


endproc

procedure DrawPanel()
     set color 255,255,255
     draw image 1,10,500
     draw image 2,120,500

endproc


procedure Cube(xoffset#, yoffset#)
   
   'x1 ; y1 ; x2 ; y2 ; x3 ; y3 ; x4 ; y4 ; bx1 ; by1 ; bx2 ; by2 ; bx3 ; by3 ; bx4 ; by4
   'x11 ; y11 ; x12 ; y12 ;x21 ; y21 ; x22 ; y22 ;x31 ; y31 ; x32 ; y32 ;x41 ; y41 ; x42 ; y42      
      proc S3D_Project x63, y63, -1.0 , -1.0 , -1.0
      proc S3D_Project x60, y60, -1.0 , -1.0 , 1.0
      proc S3D_Project x69, y69, 1.0 , -1.0 , 1.0
      proc S3D_Project x66, y66, 1.0 , -1.0 , -1.0

      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0
      proc S3D_Project x90, y90,  -1.0 , 1.0 , 1.0
      proc S3D_Project x99, y99,  1.0 , 1.0 , 1.0
      proc S3D_Project x96, y96,  1.0 , 1.0 , -1.0


 if Angle > 282.0 or Angle < 76.0 then proc Front
 if Angle < 258.0  and Angle > 103.0 then proc Back
 if Angle > 194.0 and Angle < 348.0 then proc Left
 if Angle > 13.0 and Angle < 167.0 then proc Right

    proc Top
      ' bottom Yellow
endproc

procedure Top()
     'top white    z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x64, y64, -1.0 + 0.66, -1.0 , -1.0 ; 'front
      proc S3D_Project x65, y65, -1.0 + 1.32, -1.0 , -1.0
      proc S3D_Project x1, y1, -1.0 + 0.66, -1.0 , 1.0  ; 'back
      proc S3D_Project x2, y2, -1.0 + 1.32, -1.0 , 1.0
      proc S3D_Project x62, y62, -1.0 , -1.0 , -1.0 + 0.66 ; 'left
      proc S3D_Project x61, y61, -1.0 , -1.0 , -1.0 + 1.32
      proc S3D_Project x67, y67, 1.0 , -1.0 , -1.0 + 0.66   ; 'right
      proc S3D_Project x68, y68, 1.0 , -1.0 , -1.0 + 1.32
     
      proc S3D_Project x5, y5, -0.34 , -1.0 , -0.34       ;' center left
      proc S3D_Project x3, y3, -0.34 , -1.0 , 0.32
      proc S3D_Project x6, y6, 0.32 , -1.0 , -0.34        ; ' center right
      proc S3D_Project x4, y4, 0.32 , -1.0 , 0.32
 
     p1[] = [ x63,y63,x60,y60,x69,y69,x66,y66 ]
      set color 0,0,0
       draw poly p1, 0

       ' square 1
     p1[] = [ x60,y60,x1,y1,x3,y3,x61,y61 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 2
     p1[] = [ x1,y1,x2,y2,x4,y4,x3,y3 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 3
     p1[] = [ x2,y2,x69,y69,x68,y68,x4,y4 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 4
     p1[] = [ x62,y62,x61,y61,x3,y3,x5,y5 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 5
     p1[] = [ x5,y5,x3,y3,x4,y4,x6,y6 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 6
     p1[] = [ x6,y6,x4,y4,x68,y68,x67,y67 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1
      set color 0, 0, 0
      draw poly p1

       ' square 7
     p1[] = [ x63,y63,x62,y62,x5,y5,x64,y64 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 8
     p1[] = [ x64,y64,x5,y5,x6,y6,x65,y65 ]
      set color 250,250,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 9
     p1[] = [ x65,y65,x6,y6,x67,y67,x66,y66 ]
      set color 250,250,255
       draw poly p1, 1





      set color 0, 0, 0
      draw poly p1

       ' Front
      draw ellipse x63,y63,2,2,1
      draw ellipse x64,y64,2,2,1
      draw ellipse x65,y65,2,2,1
      draw ellipse x66,y66,2,2,1
        ' Back

      draw ellipse x69,y69,2,2,1
      draw ellipse x60,y60,2,2,1
      draw ellipse x1,y1,2,2,1
      draw ellipse x2,y2,2,2,1
         ' left
      draw ellipse x62,y62,2,2,1
      draw ellipse x61,y61,2,2,1
         ' right
      draw ellipse x67,y67,2,2,1
      draw ellipse x68,y68,2,2,1

         ' center left
      draw ellipse x5,y5,2,2,1
      draw ellipse x3,y3,2,2,1
         ' center right
      draw ellipse x6,y6,2,2,1
      draw ellipse x4,y4,2,2,1


 
endproc

procedure Front()
       '  FRONT BLUE
       '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x73, y73, -1.0 , -0.34, -1.0
      proc S3D_Project x74, y74, -0.34, -0.34 , -1.0
      proc S3D_Project x75, y75, 0.32, -0.34 , -1.0  
      proc S3D_Project x76, y76, 1.0 , -0.34 , -1.0

      proc S3D_Project x83, y83, -1.0 , 0.32, -1.0  
      proc S3D_Project x84, y84, -0.34 , 0.32 , -1.0
      proc S3D_Project x85, y85, 0.32 , 0.32 , -1.0    
      proc S3D_Project x86, y86, 1.0 , 0.32 , -1.0

      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0      
      proc S3D_Project x94, y94, -0.34 , 1.0 , -1.0
      proc S3D_Project x95, y95, 0.32 , 1.0 , -1.0        
      proc S3D_Project x96, y96, 1.0 , 1.0 , -1.0

       ' square 13
     p1[] = [ x63,y63,x64,y64,x74,y74,x73,y73 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 14
     p1[] = [ x64,y64,x65,y65,x75,y75,x74,y74 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 15
     p1[] = [ x65,y65,x66,y66,x76,y76,x75,y75 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 25
     p1[] = [ x73,y73,x74,y74,x84,y84,x83,y83 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 26
     p1[] = [ x74,y74,x75,y75,x85,y85,x84,y84 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 27
     p1[] = [ x75,y75,x76,y76,x86,y86,x85,y85 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 37
     p1[] = [ x83,y83,x84,y84,x94,y94,x93,y93 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 38
     p1[] = [ x84,y84,x85,y85,x95,y95,x94,y94 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 39
     p1[] = [ x85,y85,x86,y86,x96,y96,x95,y95 ]
      set color 0,0,255
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

       ' Front
      draw ellipse x73,y73,2,2,1
      draw ellipse x74,y74,2,2,1
      draw ellipse x75,y75,2,2,1
      draw ellipse x76,y76,2,2,1
       ' Front
      draw ellipse x83,y83,2,2,1
      draw ellipse x84,y84,2,2,1
      draw ellipse x85,y85,2,2,1
      draw ellipse x86,y86,2,2,1
       ' Front
      draw ellipse x93,y93,2,2,1
      draw ellipse x94,y94,2,2,1
      draw ellipse x95,y95,2,2,1
      draw ellipse x96,y96,2,2,1
 
endproc

procedure Back()
      '   BACK GREEN

       '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x79, y79, 1.0 , -0.34, 1.0
      proc S3D_Project x14, y14, 0.32, -0.34 , 1.0
      proc S3D_Project x15, y15, -0.34, -0.34 , 1.0  
      proc S3D_Project x70, y70, -1.0 , -0.34 , 1.0

      proc S3D_Project x89, y89, 1.0 , 0.32, 1.0  
      proc S3D_Project x13, y13, 0.32 , 0.32 , 1.0
      proc S3D_Project x16, y16, -0.34 , 0.32 , 1.0    
      proc S3D_Project x80, y80, -1.0 , 0.32 , 1.0

      proc S3D_Project x99, y99, 1.0 , 1.0 , 1.0      
      proc S3D_Project x12, y12, 0.32 , 1.0 , 1.0
      proc S3D_Project x11, y11, -0.34 , 1.0 , 1.0        
      proc S3D_Project x90, y90, -1.0 , 1.0 , 1.0

       ' square 19
     p1[] = [ x69,y69,x2,y2,x14,y14,x79,y79 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 20
     p1[] = [ x2,y2,x1,y1,x15,y15,x14,y14 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 21
     p1[] = [ x1,y1,x60,y60,x70,y70,x15,y15 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 31
     p1[] = [ x79,y79,x14,y14,x13,y13,x89,y89 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 32
     p1[] = [ x14,y14,x15,y15,x16,y16,x13,y13 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 33
     p1[] = [ x15,y15,x70,y70,x80,y80,x16,y16 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 43
     p1[] = [ x89,y89,x13,y13,x12,y12,x99,y99 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 44
     p1[] = [ x13,y13,x16,y16,x11,y11,x12,y12 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 45
     p1[] = [ x16,y16,x80,y80,x90,y90,x11,y11 ]
      set color 0,255,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

       ' Back
      draw ellipse x69,y69,2,2,1
      draw ellipse x2,y2,2,2,1
      draw ellipse x1,y1,2,2,1
      draw ellipse x60,y60,2,2,1
       '
      draw ellipse x79,y79,2,2,1
      draw ellipse x14,y14,2,2,1
      draw ellipse x15,y15,2,2,1
      draw ellipse x70,y70,2,2,1
       '
      draw ellipse x89,y89,2,2,1
      draw ellipse x13,y13,2,2,1
      draw ellipse x16,y16,2,2,1
      draw ellipse x80,y80,2,2,1
 
      draw ellipse x99,y99,2,2,1
      draw ellipse x11,y11,2,2,1
      draw ellipse x12,y12,2,2,1
      draw ellipse x90,y90,2,2,1
 

endproc



procedure Left()
     '  LEFT RED
      '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
      '   -1.0 ,   0.32 , -0.34 , 1.0
      proc S3D_Project x60, y60, -1.0 , -1.0  , 1.0
      proc S3D_Project x61, y61, -1.0 , -1.0  , 0.32  
      proc S3D_Project x62, y62, -1.0 , -1.0  , -0.34  
      proc S3D_Project x63, y63, -1.0 , -1.0  , -1.0

      proc S3D_Project x70, y70, -1.0 , -0.34, 1.0  
      proc S3D_Project x71, y71, -1.0 , -0.34 , 0.32  
      proc S3D_Project x72, y72, -1.0 , -0.34 , -0.34    
      proc S3D_Project x73, y73, -1.0 , -0.34 , -1.0

      proc S3D_Project x80, y80, -1.0 , 0.32 , 1.0      
      proc S3D_Project x81, y81, -1.0 , 0.32 , 0.32  
      proc S3D_Project x82, y82, -1.0 , 0.32 , -0.34        
      proc S3D_Project x83, y83, -1.0 , 0.32 , -1.0

      proc S3D_Project x90, y90, -1.0 , 1.0 , 1.0      
      proc S3D_Project x91, y91, -1.0 , 1.0 , 0.32  
      proc S3D_Project x92, y92, -1.0 , 1.0 , -0.34        
      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0

       ' square 10
     p1[] = [ x60,y60,x61,y61,x71,y71,x70,y70 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 11
     p1[] = [ x61,y61,x62,y62,x72,y72,x71,y71 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 12
     p1[] = [ x62,y62,x63,y63,x73,y73,x72,y72 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 22
     p1[] = [ x70,y70,x71,y71,x81,y81,x80,y80 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 23
     p1[] = [ x71,y71,x72,y72,x82,y82,x81,y81 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 24
     p1[] = [ x72,y72,x73,y73,x83,y83,x82,y82 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 34
     p1[] = [ x80,y80,x81,y81,x91,y91,x90,y90 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 35
     p1[] = [ x81,y81,x82,y82,x92,y92,x91,y91 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 36
     p1[] = [ x82,y82,x83,y83,x93,y93,x92,y92 ]
      set color 255,0,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

       ' Back
      draw ellipse x60,y60,2,2,1
      draw ellipse x61,y61,2,2,1
      draw ellipse x62,y62,2,2,1
      draw ellipse x63,y63,2,2,1
       '
      draw ellipse x70,y70,2,2,1
      draw ellipse x71,y71,2,2,1
      draw ellipse x72,y72,2,2,1
      draw ellipse x73,y73,2,2,1
       '
      draw ellipse x80,y80,2,2,1
      draw ellipse x81,y81,2,2,1
      draw ellipse x82,y82,2,2,1
      draw ellipse x83,y83,2,2,1
 
      draw ellipse x90,y90,2,2,1
      draw ellipse x91,y91,2,2,1
      draw ellipse x92,y92,2,2,1
      draw ellipse x93,y93,2,2,1
 


endproc

procedure Right()
     '  RIGHT ORANGE
      '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
      '   -1.0 ,   0.32 , -0.34 , 1.0 ,
      proc S3D_Project x66, y66, 1.0 , -1.0 , -1.0      
      proc S3D_Project x67, y67, 1.0 , -1.0 , -0.34
      proc S3D_Project x68, y68, 1.0 , -1.0 ,  0.32        
      proc S3D_Project x69, y69, 1.0 , -1.0 , 1.0

      proc S3D_Project x76, y76, 1.0 , -0.34, -1.0
      proc S3D_Project x77, y77, 1.0 , -0.34 , -0.34  
      proc S3D_Project x78, y78, 1.0 , -0.34 ,  0.32  
      proc S3D_Project x79, y79, 1.0 , -0.34 , 1.0

      proc S3D_Project x86, y86, 1.0 , 0.32, -1.0  
      proc S3D_Project x87, y87, 1.0 , 0.32 , -0.34  
      proc S3D_Project x88, y88, 1.0 , 0.32 ,  0.32    
      proc S3D_Project x89, y89, 1.0 , 0.32 , 1.0

      proc S3D_Project x96, y96, 1.0 , 1.0 , -1.0      
      proc S3D_Project x97, y97, 1.0 , 1.0 , -0.34
      proc S3D_Project x98, y98, 1.0 , 1.0 ,  0.32        
      proc S3D_Project x99, y99, 1.0 , 1.0 , 1.0

       ' square 16
     p1[] = [ x66,y66,x67,y67,x77,y77,x76,y76 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 17
     p1[] = [ x67,y67,x68,y68,x78,y78,x77,y77 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 18
     p1[] = [ x68,y68,x69,y69,x79,y79,x78,y78 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 28
     p1[] = [ x76,y76,x77,y77,x87,y87,x86,y86 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 29
     p1[] = [ x77,y77,x78,y78,x88,y88,x87,y87 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 30
     p1[] = [ x78,y78,x79,y79,x89,y89,x88,y88 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 40
     p1[] = [ x86,y86,x87,y87,x97,y97,x96,y96 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 41
     p1[] = [ x87,y87,x88,y88,x98,y98,x97,y97 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 42
     p1[] = [ x88,y88,x89,y89,x99,y99,x98,y98 ]
      set color 250,155,0
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

       '
      draw ellipse x66,y66,2,2,1
      draw ellipse x67,y67,2,2,1
      draw ellipse x68,y68,2,2,1
      draw ellipse x69,y69,2,2,1
       '
      draw ellipse x76,y76,2,2,1
      draw ellipse x77,y77,2,2,1
      draw ellipse x78,y78,2,2,1
      draw ellipse x79,y79,2,2,1
       '
      draw ellipse x86,y86,2,2,1
      draw ellipse x87,y87,2,2,1
      draw ellipse x88,y88,2,2,1
      draw ellipse x89,y89,2,2,1
 
      draw ellipse x96,y96,2,2,1
      draw ellipse x97,y97,2,2,1
      draw ellipse x98,y98,2,2,1
      draw ellipse x99,y99,2,2,1
 


endproc

procedure Bottom()
   ' yellow
endproc


end






' JESUS IS COMING....... PASS IT ON


Attached Files
.bmp   Cube.bmp (Size: 189.88 KB / Downloads: 108)
Reply
#2
Hi Rick

Nice 3d cube rotation. Lot of work and lot of fun. I like 3d stuff.[Image: smile.png]
Reply
#3
Holy crap, that's an awesome example Smile I haven't looked at the code yet, but how did you do the hidden surface removal?

For those who are unfamiliar with the Simple3D library, all it can do is to apply transformations in 3D and project points to screen coordinates. It provides no functionality for the actual drawing.
Reply
#4
(06-27-2018, 09:52 AM)Marcus Wrote: Holy crap, that's an awesome example Smile I haven't looked at the code yet, but how did you do the hidden surface removal?

For those who are unfamiliar with the Simple3D library, all it can do is to apply transformations in 3D and project points to screen coordinates. It provides no functionality for the actual drawing.

  I used a simple idea. I draw a face only when it is at the correct rotation angle.
Reply
#5
(06-27-2018, 12:28 PM)Rick3137 Wrote:
(06-27-2018, 09:52 AM)Marcus Wrote: Holy crap, that's an awesome example Smile I haven't looked at the code yet, but how did you do the hidden surface removal?

For those who are unfamiliar with the Simple3D library, all it can do is to apply transformations in 3D and project points to screen coordinates. It provides no functionality for the actual drawing.

  I used a simple idea. I draw a face only when it is at the correct rotation angle.

I'm impressed, and the approach is certainly good enough Smile  But now you got me started, and as soon as I get home from work I'll have to write an example of more generic back-to-front rendering of polygons Smile
Reply
#6
(06-27-2018, 01:38 PM)Marcus Wrote:
(06-27-2018, 12:28 PM)Rick3137 Wrote:
(06-27-2018, 09:52 AM)Marcus Wrote: Holy crap, that's an awesome example Smile I haven't looked at the code yet, but how did you do the hidden surface removal?

For those who are unfamiliar with the Simple3D library, all it can do is to apply transformations in 3D and project points to screen coordinates. It provides no functionality for the actual drawing.

  I used a simple idea. I draw a face only when it is at the correct rotation angle.

I'm impressed, and the approach is certainly good enough Smile  But now you got me started, and as soon as I get home from work I'll have to write an example of more generic back-to-front rendering of polygons Smile

     Nice,

  I look forward to seeing that. This library could be expanded into something very useful.
Reply
#7
Version 2

 I think I have a playable cube. There are still some details to work out like labeling of buttons.

 I could also use more 3d animation.

[Image: attachment.php?aid=77]

Code:
   '  By Rick3137    http://rb23.yolasite.com/
   '  You have permission to copy, paste, alter or post anywhere as long as you don't copyright my work.
   '  If it breaks your computer or does damage to your health or wealth , I didn't do it.
   '  You have permission to translate to other languages, like Android and copyright that version.

import "Simple3D.lib"
import "Speed.lib"
set redraw off
randomize time()
visible:
  a1 = 0 ; mb = 0 ; a2 = 0 ; mx ; my ; zn ; c1 ; c2 ; c3 ; zn2 ; d1 = 0 ; d2 = 0 ; d3 = 0
  Angle# = 0.0
   x1;x2;x3;x4;x5;x6;x7;x8;x9;x10;x11;x12;x13;x14;x15;x16;x17;x18;x19;x20;x21;x22;x23;x24;x25;x26;x27;x28;x29;x30;x31;x32;x33;x34;x35;x36;x37;x38;x39
   x40;x41;x42;x43;x44;x45;x46;x47;x48;x49;x50;x51;x52;x53;x54;x55;x56;x57;x58;x59;x60;x61;x62
   y1;y2;y3;y4;y5;y6;y7;y8;y9;y10;y11;y12;y13;y14;y15;y16;y17;y18;y19;y20;y21;y22;y23;y24;y25;y26;y27;y28;y29;y30;y31;y32;y33;y34;y35;y36;y37;y38;y39
   y40;y41;y42;y43;y44;y45;y46;y47;y48;y49;y50;y51;y52;y53;y54;y55;y56;y57;y58;y59;y60;y61;y62

   x63;x64;x65;x66;x67;x68;x69;x70;x71;x72;x73;x74;x75;x76;x77;x78;x79;x80;x81;x82;x83;x84;x85;x86;x87;x88;x89;x90;x91;x92;x93;x94;x95;x96;x97;x98;x99
   y63;y64;y65;y66;y67;y68;y69;y70;y71;y72;y73;y74;y75;y76;y77;y78;y79;y80;y81;y82;y83;y84;y85;y86;y87;y88;y89;y90;y91;y92;y93;y94;y95;y96;y97;y98;y99

   clr[70]
 
hidden:
set window 0,0,1100,750
   
 proc Setup
 proc SetFrame

do

 set color 100, 100, 90
    cls
 mx = mousex()
 my = mousey()

 proc Input
 set caret 20,20
    set color 255, 255, 255
   wln Angle
   wln str$(mx)
   wln str$(my)
   wln str$(zn2)
   wln str$(d1)
   wln str$(d2)
   wln str$(d3)

 proc SetFrame
 proc Cube 1.0, 1.0

 proc DrawPanel
    redraw
 'wait 10
 proc SPD_HoldFrame 120
 
until keydown(27, true)
' END PROGRAM

procedure SetFrame()
 proc S3D_ClearTransformation
 proc S3D_SetView 60.0, 0.1, 10.0
    proc S3D_Translate 0.0, -1.0, 20.0
    proc S3D_RotateX 30.0
 proc S3D_RotateY Angle
 proc S3D_Scale 4.0,4.0,4.0


' translate 10.0, 2.0
endproc


procedure Input()
        z1 = 0 ; z2 = 0 ; zn = 0
        z1 = zone(1) ; z2 = zone(2) ; z3 = zone(3) ; z4 = zone(4) ; z5 = zone(5) ; z6 = zone(6); z7 = zone(7) ;  z8 = zone(8)
        z9 = zone(9) ; z10 = zone(10) ; z11 = zone(11) ; z12 = zone(12) ; z13 = zone(13) ; z14 = zone(14); z15 = zone(15) ;  z16 = zone(16)
        z17 = zone(17) ; z18 = zone(18) ; z19 = zone(19) ; z20 = zone(20)
        z21 = zone(21) ; z22 = zone(22) ; z23 = zone(23) ; z24 = zone(24) ; z25 = zone(25)



  if z1 = 2 then zn = 1 ; if z2 = 2 then zn = 2 ; if z3 = 2 then zn = 3; if z4 = 2 then zn = 4; if z5 = 2 then zn = 5; if z6 = 2 then zn = 6; if z7 = 2 then zn = 7; if z8 = 2 then zn = 8
  if z9 = 2 then zn = 9 ; if z10 = 2 then zn = 10 ; if z11 = 2 then zn = 11; if z12 = 2 then zn = 12; if z13 = 2 then zn = 13; if z14 = 2 then zn = 14
  if z15 = 2 then zn = 15 ; if z16 = 2 then zn = 16 ; if z17 = 2 then zn = 17; if z18 = 2 then zn = 18; if z19 = 2 then zn = 19; if z20 = 2 then zn = 20
  if z21 = 2 then zn = 21 ; if z22 = 2 then zn = 22 ; if z23 = 2 then zn = 23; if z24 = 2 then zn = 24; if z25 = 2 then zn = 25;

  zn2 = zn         
           if zn = 1 then    Angle = Angle + 1.0
        if zn = 2 then  Angle = Angle - 1.0

     if zn > 2 and zn < 21 then proc Dzone zn

       if zn = 21 then proc Shuffle 3
       if zn = 22 then proc Shuffle 5
       if zn = 23 then proc Shuffle 7
       if zn = 24 then proc Shuffle 9
       if zn = 25 then proc Reset
       if zn > 20
         zn = 0
         wait 100
       endif

       if Angle > 360.0 then Angle = 0.0
       if Angle < 0.0 then Angle = 360.0
     
endproc

procedure Shuffle(a)
   b = rnd(6) + 3
   c = rnd(6) + 9
   d = rnd(6) + 15
   proc Dzone b
   proc Dzone c
   proc Dzone d
   d1 = b ; d2 = c ; d3 = d
  if a > 3
   b = rnd(6) + 3
   c = rnd(6) + 9
   proc Dzone b ; proc Dzone c
  endif
  if a > 5
   b = rnd(6) + 3
   d = rnd(6) + 15
   proc Dzone b ; proc Dzone d
  endif
  if a > 7
   b = rnd(6) + 3
   c = rnd(6) + 9
   proc Dzone b ; proc Dzone c
  endif

endproc

procedure Dzone(z)


        if z = 3
         c1 = clr[34] ; c2 = clr[35] ; c3 = clr[36] ; clr[34] = clr[37] ; clr[35] = clr[38] ;clr[36] = clr[39] ; clr[37] = clr[40] ; clr[38] = clr[41]; clr[39] = clr[42]
         clr[40] = clr[43] ; clr[41] = clr[44] ; clr[42] = clr[45]; clr[43] = c1 ; clr[44] = c2 ; clr[45] = c3
         c1 = clr[46] ; c2 = clr[47] ; c3 = clr[48] ; clr[46] = clr[48] ; clr[47] = clr[51] ;clr[48] = clr[54] ; clr[51] = clr[53] ; clr[54] = clr[52] ;clr[53] = clr[49] ;
         clr[52] = c1 ; clr[49] = c2 ; clr[46] = c3

         zn = 0
         wait 100
       endif
       if z = 4
         c1 = clr[43] ; c2 = clr[44] ; c3 = clr[45] ; clr[43] = clr[40] ; clr[44] = clr[41] ;clr[45] = clr[42] ; clr[40] = clr[37] ; clr[41] = clr[38]; clr[42] = clr[39]
         clr[37] = clr[34] ; clr[38] = clr[35] ; clr[39] = clr[36]; clr[34] = c1 ; clr[35] = c2 ; clr[36] = c3
         c1 = clr[46] ; c2 = clr[47] ; c3 = clr[48] ; clr[48] = clr[46] ; clr[47] = clr[49] ;clr[46] = clr[52] ; clr[49] = clr[53] ; clr[52] = clr[54] ;clr[53] = clr[51] ;
         clr[54] = c3 ; clr[51] = c2 ; clr[48] = c1

         zn = 0
         wait 100
       endif
       if z = 5
         c1 = clr[22] ; c2 = clr[23] ; c3 = clr[24] ; clr[22] = clr[25] ; clr[23] = clr[26] ;clr[24] = clr[27] ; clr[25] = clr[28] ; clr[26] = clr[29]; clr[27] = clr[30]
         clr[28] = clr[31] ; clr[29] = clr[32] ; clr[30] = clr[33]; clr[31] = c1 ; clr[32] = c2 ; clr[33] = c3
         zn = 0
         wait 100
       endif
       if z = 6
         c1 = clr[31] ; c2 = clr[32] ; c3 = clr[33] ; clr[31] = clr[28] ; clr[32] = clr[29] ;clr[33] = clr[30] ; clr[28] = clr[25] ; clr[29] = clr[26]; clr[30] = clr[27]
         clr[25] = clr[22] ; clr[26] = clr[23] ; clr[27] = clr[24]; clr[22] = c1 ; clr[23] = c2 ; clr[24] = c3
         zn = 0
         wait 100
       endif
       if z = 7
         c1 = clr[10] ; c2 = clr[11] ; c3 = clr[12] ; clr[10] = clr[13] ; clr[11] = clr[14] ;clr[12] = clr[15] ; clr[13] = clr[16] ; clr[14] = clr[17]; clr[15] = clr[18]
         clr[16] = clr[19] ; clr[17] = clr[20] ; clr[18] = clr[21]; clr[19] = c1 ; clr[20] = c2 ; clr[21] = c3
         c1 = clr[7] ; c2 = clr[8] ; c3 = clr[9] ; clr[7] = clr[9] ; clr[8] = clr[6] ;clr[9] = clr[3] ; clr[6] = clr[2] ; clr[3] = clr[1] ;clr[2] = clr[4] ;
         clr[1] = c1 ; clr[4] = c2 ; clr[7] = c3
         zn = 0
         wait 100
       endif
       if z = 8
         c1 = clr[19] ; c2 = clr[20] ; c3 = clr[21] ; clr[19] = clr[16] ; clr[20] = clr[17] ;clr[21] = clr[18] ; clr[16] = clr[13] ; clr[17] = clr[14]; clr[18] = clr[15]
         clr[13] = clr[10] ; clr[14] = clr[11] ; clr[15] = clr[12]; clr[10] = c1 ; clr[11] = c2 ; clr[12] = c3
         c1 = clr[7] ; c2 = clr[8] ; c3 = clr[9] ; clr[9] = clr[7] ; clr[8] = clr[4] ;clr[7] = clr[1] ; clr[4] = clr[2] ; clr[1] = clr[3] ;clr[2] = clr[6] ;
         clr[3] = c3 ; clr[6] = c2 ; clr[9] = c1

         zn = 0
         wait 100
       endif

       if z = 15
         c1 = clr[52] ; c2 = clr[49] ; c3 = clr[46] ; clr[46] = clr[45] ; clr[49] = clr[33] ;clr[52] = clr[21] ; clr[45] = clr[1] ; clr[33] = clr[4]; clr[21] = clr[7]
         clr[1] = clr[13] ; clr[4] = clr[25] ; clr[7] = clr[37]; clr[13] = c3 ; clr[25] = c2 ; clr[37] = c1
         c1 = clr[10] ; c2 = clr[11] ; c3 = clr[12] ; clr[11] = clr[24] ; clr[12] = clr[36] ;clr[24] = clr[35] ; clr[36] = clr[34] ; clr[35] = clr[22]  ;
         clr[34] = c1 ; clr[22] = c2 ; clr[10] = c3

         zn = 0
         wait 100
       endif

       if z = 16
         c1 = clr[53] ; c2 = clr[50] ; c3 = clr[47] ; clr[47] = clr[44] ; clr[50] = clr[32] ;clr[53] = clr[20] ; clr[44] = clr[2] ; clr[32] = clr[5]; clr[20] = clr[8]
         clr[2] = clr[14] ; clr[5] = clr[26] ; clr[8] = clr[38]; clr[14] = c3 ; clr[26] = c2 ; clr[38] = c1
         zn = 0
         wait 100
       endif

       if z = 17
         c1 = clr[54] ; c2 = clr[51] ; c3 = clr[48] ; clr[48] = clr[43] ; clr[51] = clr[31] ;clr[54] = clr[19] ; clr[43] = clr[3] ; clr[31] = clr[6]; clr[19] = clr[9]
         clr[3] = clr[15] ; clr[6] = clr[27] ; clr[9] = clr[39]; clr[15] = c3 ; clr[27] = c2 ; clr[39] = c1
         c1 = clr[16] ; c2 = clr[17] ; c3 = clr[18] ; clr[17] = clr[30] ; clr[18] = clr[42] ;clr[30] = clr[41] ; clr[42] = clr[40] ; clr[41] = clr[28]  ;
         clr[40] = c1 ; clr[28] = c2 ; clr[16] = c3

         zn = 0
         wait 100
       endif

       if z = 18
         c1 = clr[46] ; c2 = clr[49] ; c3 = clr[52] ; clr[52] = clr[37] ; clr[49] = clr[25] ;clr[46] = clr[13] ; clr[37] = clr[7] ; clr[25] = clr[4]; clr[13] = clr[1]
         clr[7] = clr[21] ; clr[4] = clr[33] ; clr[1] = clr[45]; clr[21] = c3 ; clr[33] = c2 ; clr[45] = c1
         c1 = clr[10] ; c2 = clr[11] ; c3 = clr[12] ; clr[11] = clr[22] ; clr[10] = clr[34] ;clr[22] = clr[35] ; clr[34] = clr[36] ; clr[35] = clr[24]  ;
         clr[12] = c1 ; clr[24] = c2 ; clr[36] = c3

         zn = 0
         wait 100
       endif

       if z = 19
         c1 = clr[47] ; c2 = clr[50] ; c3 = clr[53] ; clr[53] = clr[38] ; clr[50] = clr[26] ;clr[47] = clr[14] ; clr[38] = clr[8] ; clr[26] = clr[5]; clr[14] = clr[2]
         clr[8] = clr[20] ; clr[5] = clr[32] ; clr[2] = clr[44]; clr[20] = c3 ; clr[32] = c2 ; clr[44] = c1
         zn = 0
         wait 100
       endif

       if z = 20
         c1 = clr[48] ; c2 = clr[51] ; c3 = clr[54] ; clr[54] = clr[39] ; clr[51] = clr[27] ;clr[48] = clr[15] ; clr[39] = clr[9] ; clr[27] = clr[6]; clr[15] = clr[3]
         clr[9] = clr[19] ; clr[6] = clr[31] ; clr[3] = clr[43]; clr[19] = c3 ; clr[31] = c2 ; clr[43] = c1
         c1 = clr[16] ; c2 = clr[17] ; c3 = clr[18] ; clr[17] = clr[28] ; clr[16] = clr[40] ;clr[28] = clr[41] ; clr[40] = clr[42] ; clr[41] = clr[30]  ;
         clr[18] = c1 ; clr[30] = c2 ; clr[42] = c3

         zn = 0
         wait 100
       endif

       if z = 9
         c1 = clr[46] ; c2 = clr[47] ; c3 = clr[48] ; clr[46] = clr[12] ; clr[47] = clr[24] ;clr[48] = clr[36] ; clr[36] = clr[7] ; clr[24] = clr[8]; clr[12] = clr[9]
         clr[7] = clr[16] ; clr[8] = clr[28] ; clr[9] = clr[40]; clr[16] = c3 ; clr[28] = c2 ; clr[40] = c1
         c1 = clr[13] ; c2 = clr[14] ; c3 = clr[15] ; clr[14] = clr[27] ; clr[15] = clr[39] ;clr[27] = clr[38] ; clr[39] = clr[37] ; clr[38] = clr[25]  ;
         clr[37] = c1 ; clr[25] = c2 ; clr[13] = c3

         zn = 0
         wait 100
       endif

       if z = 10
         c1 = clr[49] ; c2 = clr[50] ; c3 = clr[51]  ; clr[49] = clr[11] ; clr[50] = clr[23] ;clr[51] = clr[35]  ; clr[11] = clr[6] ; clr[23] = clr[5]; clr[35] = clr[4]
         clr[6] = clr[41] ; clr[5] = clr[29] ; clr[4] = clr[17];   clr[17] = c3 ; clr[29] = c2 ; clr[41] = c1
         zn = 0
         wait 100
       endif

       if z = 11
         c1 = clr[52] ; c2 = clr[53] ; c3 = clr[54]  ; clr[54] = clr[34] ; clr[53] = clr[22] ;clr[52] = clr[10]  ; clr[34] = clr[1] ; clr[22] = clr[2]; clr[10] = clr[3]
         clr[1] = clr[18] ; clr[2] = clr[30] ; clr[3] = clr[42];   clr[18] = c3 ; clr[30] = c2 ; clr[42] = c1
         c1 = clr[19] ; c2 = clr[20] ; c3 = clr[21] ; clr[20] = clr[33] ; clr[21] = clr[45] ;clr[33] = clr[44] ; clr[45] = clr[43] ; clr[44] = clr[31]  ;
         clr[43] = c1 ; clr[31] = c2 ; clr[19] = c3

         zn = 0
         wait 100
       endif

       if z = 12
         c1 = clr[48] ; c2 = clr[47] ; c3 = clr[46]  ; clr[46] = clr[40] ; clr[47] = clr[28] ;clr[48] = clr[16]  ; clr[40] = clr[9] ; clr[28] = clr[8]; clr[16] = clr[7]
         clr[9] = clr[12] ; clr[8] = clr[24] ; clr[7] = clr[36];   clr[12] = c3 ; clr[24] = c2 ; clr[36] = c1
         c1 = clr[13] ; c2 = clr[14] ; c3 = clr[15] ; clr[15] = clr[13] ; clr[14] = clr[25] ;clr[13] = clr[37] ; clr[25] = clr[38] ; clr[37] = clr[39] ;clr[38] = clr[27] ;
         clr[39] = c3 ; clr[27] = c2 ; clr[15] = c1
         zn = 0
         wait 100
       endif

       if z = 13
         c1 = clr[51] ; c2 = clr[50] ; c3 = clr[49]  ; clr[49] = clr[41] ; clr[50] = clr[29] ;clr[51] = clr[17]  ; clr[41] = clr[6] ; clr[29] = clr[5]; clr[17] = clr[4]
         clr[6] = clr[11] ; clr[5] = clr[23] ; clr[4] = clr[35];   clr[11] = c3 ; clr[23] = c2 ; clr[35] = c1
         zn = 0
         wait 100
       endif
    
       if z = 14
         c1 = clr[54] ; c2 = clr[53] ; c3 = clr[52]  ; clr[52] = clr[42] ; clr[53] = clr[30] ;clr[54] = clr[18]  ; clr[42] = clr[3] ; clr[30] = clr[2]; clr[18] = clr[1]
         clr[3] = clr[10] ; clr[2] = clr[22] ; clr[1] = clr[34];   clr[10] = c3 ; clr[22] = c2 ; clr[34] = c1
         c1 = clr[19] ; c2 = clr[20] ; c3 = clr[21] ; clr[20] = clr[31] ; clr[19] = clr[43] ;clr[31] = clr[44] ; clr[43] = clr[45] ; clr[44] = clr[33]  ;
         clr[21] = c1 ; clr[33] = c2 ; clr[45] = c3

         zn = 0
         wait 100
       endif
 
endproc

procedure Reset()
    for a = 1 to 54
        if a<10 then clr[a] = 1 ; ' white
        if a>45 then clr[a] = 6 ; ' yellow
        if a=10 or a=11 or a=12 or a=22 or a=23 or a=24 or a=34 or a=35 or a=36 then clr[a] = 2 ;  ' red
        if a=13 or a=14 or a=15 or a=25 or a=26 or a=27 or a=37 or a=38 or a=39 then clr[a] = 3 ;  ' blue
        if a=16 or a=17 or a=18 or a=28 or a=29 or a=30 or a=40 or a=41 or a=42 then clr[a] = 4 ;  ' orange
        if a=19 or a=20 or a=21 or a=31 or a=32 or a=33 or a=43 or a=44 or a=45 then clr[a] = 5 ;  ' green

    next
endproc

procedure Setup()
    proc CreateArrows
    proc SetZones
     set image primary
     set color 255, 255, 255
    ' create font 0, "arial" , 24
    ' set font 0
    for a = 1 to 54
        if a<10 then clr[a] = 1 ; ' white
        if a>45 then clr[a] = 6 ; ' yellow
        if a=10 or a=11 or a=12 or a=22 or a=23 or a=24 or a=34 or a=35 or a=36 then clr[a] = 2 ;  ' red
        if a=13 or a=14 or a=15 or a=25 or a=26 or a=27 or a=37 or a=38 or a=39 then clr[a] = 3 ;  ' blue
        if a=16 or a=17 or a=18 or a=28 or a=29 or a=30 or a=40 or a=41 or a=42 then clr[a] = 4 ;  ' orange
        if a=19 or a=20 or a=21 or a=31 or a=32 or a=33 or a=43 or a=44 or a=45 then clr[a] = 5 ;  ' green

    next
endproc

procedure SetZones()
          create zone 1,100,500, 60, 40
          create zone 2,200,500, 60, 40
          create zone 3,100,400, 60, 40
          create zone 4,200,400, 60, 40
          create zone 5,100,300, 60, 40
          create zone 6,200,300, 60, 40
          create zone 7,100,200, 60, 40
          create zone 8,200,200, 60, 40

          create zone 9,800,150, 40, 60
          create zone 10,900,150, 40, 60
          create zone 11,1000,150, 40, 60
          create zone 12,800,250, 40, 60
          create zone 13,900,250, 40, 60
          create zone 14,1000,250, 40, 60
          create zone 15,800,400, 40, 60
          create zone 16,900,400, 40, 60
          create zone 17,1000,400, 40, 60
          create zone 18,800,500, 40, 60
          create zone 19,900,500, 40, 60
          create zone 20,1000,500, 40, 60

          create zone 21,300,620, 80, 40
          create zone 22,400,620, 80, 40
          create zone 23,500,620, 80, 40
          create zone 24,600,620, 80, 40
          create zone 25,700,620, 80, 40



endproc

procedure CreateArrows()
   create image 1 ,100,100 ;     create image 2 ,100,100 ;     create image 3 ,41,71 ;     create image 4 ,41,71
   create image 5 ,80,40 ;     create image 6 ,80,40 ;     create image 7 ,80,40 ;     create image 8 ,80,40 ;     create image 9 ,80,40

   p1[] = [ 20,0,20,10,60,10,60,30,20,30,20,40,0,20 ] ; p2[] = [ 0,10,40,10,40,0,60,20,40,40,40,30,0,30 ]
   
   p3[] = [ 10,10,30,10,30,50,40,50,20,70,0,50,10,50 ] ; p4[] = [ 20,10,40,30,30,30,30,70,10,70,10,30,0,30 ]

   set image 1
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 110, 120, 130
         draw poly p1,1
         set color 255, 255, 255
         draw poly p1,0
   set image 2
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 110, 120, 130
         draw poly p2,1
        set color 255, 255, 255
         draw poly p2,0


   set image 3
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 110, 120, 130
         draw poly p3,1
         set color 255, 255, 255
         draw poly p3,0
         
   set image 4
         set color 100, 100, 90
         draw rect 0,0,100,100, 1

         set color 110, 120, 130
         draw poly p4,1
         set color 255, 255, 255
         draw poly p4,0


   set image 5
         set color 200, 200, 250
         draw rect 0,0,80,40, 1
         set color 15, 15, 15
         draw rect 2,2,76,36, 0
         set caret 5,11
         write "Shuffle3"
         set color 255, 255, 255

   set image 6
         set color 200, 200, 250
         draw rect 0,0,80,40, 1
         set color 15, 15, 15
         draw rect 2,2,76,36, 0
         set caret 5,11
         write "Shuffle5"
   set image 7
         set color 200, 200, 250
         draw rect 0,0,80,40, 1
         set color 15, 15, 15
         draw rect 2,2,76,36, 0
         set caret 5,11
         write "Shuffle7"
   set image 8
         set color 200, 200, 250
         draw rect 0,0,80,40, 1
         set color 15, 15, 15
         draw rect 2,2,76,36, 0
         set caret 5,11
         write "Shuffle9"
   set image 9
         set color 200, 200, 250
         draw rect 0,0,80,40, 1
         set color 15, 15, 15
         draw rect 2,2,76,36, 0
         set caret 5,11
         write " Reset"


       
   set image primary
     set color 255, 255, 255


endproc

procedure DrawPanel()
     set color 255,255,255
     draw image 1,100,500
     draw image 2,200,500

     draw image 1,100,400
     draw image 2,200,400

     draw image 1,100,300
     draw image 2,200,300

     draw image 1,100,200
     draw image 2,200,200

     draw image 3,800,500
     draw image 4,800,400

     draw image 3,900,500
     draw image 4,900,400

     draw image 3,1000,500
     draw image 4,1000,400

     draw image 3,800,250
     draw image 4,800,150

     draw image 3,900,250
     draw image 4,900,150

     draw image 3,1000,250
     draw image 4,1000,150

     draw image 5,300,620
     draw image 6,400,620
     draw image 7,500,620
     draw image 8,600,620
     draw image 9,700,620


endproc


procedure Cube(xoffset#, yoffset#)
   
   'x1 ; y1 ; x2 ; y2 ; x3 ; y3 ; x4 ; y4 ; bx1 ; by1 ; bx2 ; by2 ; bx3 ; by3 ; bx4 ; by4
   'x11 ; y11 ; x12 ; y12 ;x21 ; y21 ; x22 ; y22 ;x31 ; y31 ; x32 ; y32 ;x41 ; y41 ; x42 ; y42      
      proc S3D_Project x63, y63, -1.0 , -1.0 , -1.0
      proc S3D_Project x60, y60, -1.0 , -1.0 , 1.0
      proc S3D_Project x69, y69, 1.0 , -1.0 , 1.0
      proc S3D_Project x66, y66, 1.0 , -1.0 , -1.0

      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0
      proc S3D_Project x90, y90,  -1.0 , 1.0 , 1.0
      proc S3D_Project x99, y99,  1.0 , 1.0 , 1.0
      proc S3D_Project x96, y96,  1.0 , 1.0 , -1.0


 if Angle > 282.0 or Angle < 76.0 then proc Front
 if Angle < 258.0  and Angle > 103.0 then proc Back
 if Angle > 194.0 and Angle < 348.0 then proc Left
 if Angle > 13.0 and Angle < 167.0 then proc Right

    proc Top
      ' bottom Yellow
endproc

procedure Top()
     'top white    z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x64, y64, -1.0 + 0.66, -1.0 , -1.0 ; 'front
      proc S3D_Project x65, y65, -1.0 + 1.32, -1.0 , -1.0
      proc S3D_Project x1, y1, -1.0 + 0.66, -1.0 , 1.0  ; 'back
      proc S3D_Project x2, y2, -1.0 + 1.32, -1.0 , 1.0
      proc S3D_Project x62, y62, -1.0 , -1.0 , -1.0 + 0.66 ; 'left
      proc S3D_Project x61, y61, -1.0 , -1.0 , -1.0 + 1.32
      proc S3D_Project x67, y67, 1.0 , -1.0 , -1.0 + 0.66   ; 'right
      proc S3D_Project x68, y68, 1.0 , -1.0 , -1.0 + 1.32
     
      proc S3D_Project x5, y5, -0.34 , -1.0 , -0.34       ;' center left
      proc S3D_Project x3, y3, -0.34 , -1.0 , 0.32
      proc S3D_Project x6, y6, 0.32 , -1.0 , -0.34        ; ' center right
      proc S3D_Project x4, y4, 0.32 , -1.0 , 0.32
 

       ' square 1
     p1[] = [ x60,y60,x1,y1,x3,y3,x61,y61 ]
      proc  MakeColor clr[1]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 2
     p1[] = [ x1,y1,x2,y2,x4,y4,x3,y3 ]
      proc  MakeColor clr[2]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 3
     p1[] = [ x2,y2,x69,y69,x68,y68,x4,y4 ]
      proc  MakeColor clr[3]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 4
     p1[] = [ x62,y62,x61,y61,x3,y3,x5,y5 ]
      proc  MakeColor clr[4]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 5
     p1[] = [ x5,y5,x3,y3,x4,y4,x6,y6 ]
      proc  MakeColor clr[5]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 6
     p1[] = [ x6,y6,x4,y4,x68,y68,x67,y67 ]
      proc  MakeColor clr[6]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1
      set color 0, 0, 0
      draw poly p1

       ' square 7
     p1[] = [ x63,y63,x62,y62,x5,y5,x64,y64 ]
      proc  MakeColor clr[7]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 8
     p1[] = [ x64,y64,x5,y5,x6,y6,x65,y65 ]
      proc  MakeColor clr[8]      
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 9
     p1[] = [ x65,y65,x6,y6,x67,y67,x66,y66 ]
      proc  MakeColor clr[9]      
       draw poly p1, 1

      set color 0, 0, 0
      draw poly p1

 
endproc

procedure Front()
       '  FRONT BLUE
       '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x73, y73, -1.0 , -0.34, -1.0
      proc S3D_Project x74, y74, -0.34, -0.34 , -1.0
      proc S3D_Project x75, y75, 0.32, -0.34 , -1.0  
      proc S3D_Project x76, y76, 1.0 , -0.34 , -1.0

      proc S3D_Project x83, y83, -1.0 , 0.32, -1.0  
      proc S3D_Project x84, y84, -0.34 , 0.32 , -1.0
      proc S3D_Project x85, y85, 0.32 , 0.32 , -1.0    
      proc S3D_Project x86, y86, 1.0 , 0.32 , -1.0

      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0      
      proc S3D_Project x94, y94, -0.34 , 1.0 , -1.0
      proc S3D_Project x95, y95, 0.32 , 1.0 , -1.0        
      proc S3D_Project x96, y96, 1.0 , 1.0 , -1.0

       ' square 13
     p1[] = [ x63,y63,x64,y64,x74,y74,x73,y73 ]
      proc  MakeColor clr[13]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 14
     p1[] = [ x64,y64,x65,y65,x75,y75,x74,y74 ]
      proc  MakeColor clr[14]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 15
     p1[] = [ x65,y65,x66,y66,x76,y76,x75,y75 ]
      proc  MakeColor clr[15]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 25
     p1[] = [ x73,y73,x74,y74,x84,y84,x83,y83 ]
      proc  MakeColor clr[25]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 26
     p1[] = [ x74,y74,x75,y75,x85,y85,x84,y84 ]
      proc  MakeColor clr[26]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 27
     p1[] = [ x75,y75,x76,y76,x86,y86,x85,y85 ]
      proc  MakeColor clr[27]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 37
     p1[] = [ x83,y83,x84,y84,x94,y94,x93,y93 ]
      proc  MakeColor clr[37]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 38
     p1[] = [ x84,y84,x85,y85,x95,y95,x94,y94 ]
      proc  MakeColor clr[38]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 39
     p1[] = [ x85,y85,x86,y86,x96,y96,x95,y95 ]
      proc  MakeColor clr[39]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

 
endproc

procedure Back()
      '   BACK GREEN

       '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
       
      proc S3D_Project x79, y79, 1.0 , -0.34, 1.0
      proc S3D_Project x14, y14, 0.32, -0.34 , 1.0
      proc S3D_Project x15, y15, -0.34, -0.34 , 1.0  
      proc S3D_Project x70, y70, -1.0 , -0.34 , 1.0

      proc S3D_Project x89, y89, 1.0 , 0.32, 1.0  
      proc S3D_Project x13, y13, 0.32 , 0.32 , 1.0
      proc S3D_Project x16, y16, -0.34 , 0.32 , 1.0    
      proc S3D_Project x80, y80, -1.0 , 0.32 , 1.0

      proc S3D_Project x99, y99, 1.0 , 1.0 , 1.0      
      proc S3D_Project x12, y12, 0.32 , 1.0 , 1.0
      proc S3D_Project x11, y11, -0.34 , 1.0 , 1.0        
      proc S3D_Project x90, y90, -1.0 , 1.0 , 1.0

       ' square 19
     p1[] = [ x69,y69,x2,y2,x14,y14,x79,y79 ]
      proc  MakeColor clr[19]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 20
     p1[] = [ x2,y2,x1,y1,x15,y15,x14,y14 ]
      proc  MakeColor clr[20]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 21
     p1[] = [ x1,y1,x60,y60,x70,y70,x15,y15 ]
      proc  MakeColor clr[21]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 31
     p1[] = [ x79,y79,x14,y14,x13,y13,x89,y89 ]
      proc  MakeColor clr[31]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 32
     p1[] = [ x14,y14,x15,y15,x16,y16,x13,y13 ]
      proc  MakeColor clr[32]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 33
     p1[] = [ x15,y15,x70,y70,x80,y80,x16,y16 ]
      proc  MakeColor clr[33]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 43
     p1[] = [ x89,y89,x13,y13,x12,y12,x99,y99 ]
      proc  MakeColor clr[43]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 44
     p1[] = [ x13,y13,x16,y16,x11,y11,x12,y12 ]
      proc  MakeColor clr[44]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 45
     p1[] = [ x16,y16,x80,y80,x90,y90,x11,y11 ]
      proc  MakeColor clr[45]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

endproc



procedure Left()
     '  LEFT RED
      '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
      '   -1.0 ,   0.32 , -0.34 , 1.0
      proc S3D_Project x60, y60, -1.0 , -1.0  , 1.0
      proc S3D_Project x61, y61, -1.0 , -1.0  , 0.32  
      proc S3D_Project x62, y62, -1.0 , -1.0  , -0.34  
      proc S3D_Project x63, y63, -1.0 , -1.0  , -1.0

      proc S3D_Project x70, y70, -1.0 , -0.34, 1.0  
      proc S3D_Project x71, y71, -1.0 , -0.34 , 0.32  
      proc S3D_Project x72, y72, -1.0 , -0.34 , -0.34    
      proc S3D_Project x73, y73, -1.0 , -0.34 , -1.0

      proc S3D_Project x80, y80, -1.0 , 0.32 , 1.0      
      proc S3D_Project x81, y81, -1.0 , 0.32 , 0.32  
      proc S3D_Project x82, y82, -1.0 , 0.32 , -0.34        
      proc S3D_Project x83, y83, -1.0 , 0.32 , -1.0

      proc S3D_Project x90, y90, -1.0 , 1.0 , 1.0      
      proc S3D_Project x91, y91, -1.0 , 1.0 , 0.32  
      proc S3D_Project x92, y92, -1.0 , 1.0 , -0.34        
      proc S3D_Project x93, y93, -1.0 , 1.0 , -1.0

       ' square 10
     p1[] = [ x60,y60,x61,y61,x71,y71,x70,y70 ]
      proc  MakeColor clr[10]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 11
     p1[] = [ x61,y61,x62,y62,x72,y72,x71,y71 ]
      proc  MakeColor clr[11]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 12
     p1[] = [ x62,y62,x63,y63,x73,y73,x72,y72 ]
      proc  MakeColor clr[12]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 22
     p1[] = [ x70,y70,x71,y71,x81,y81,x80,y80 ]
      proc  MakeColor clr[22]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 23
     p1[] = [ x71,y71,x72,y72,x82,y82,x81,y81 ]
      proc  MakeColor clr[23]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 24
     p1[] = [ x72,y72,x73,y73,x83,y83,x82,y82 ]
      proc  MakeColor clr[24]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 34
     p1[] = [ x80,y80,x81,y81,x91,y91,x90,y90 ]
      proc  MakeColor clr[34]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 35
     p1[] = [ x81,y81,x82,y82,x92,y92,x91,y91 ]
      proc  MakeColor clr[35]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 36
     p1[] = [ x82,y82,x83,y83,x93,y93,x92,y92 ]
      proc  MakeColor clr[36]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




       set color 0, 0, 0
     ' draw poly p1

 endproc

procedure Right()
     '  RIGHT ORANGE
      '  z axis is positive far away into screen  y axis is negative toward top of screen   x axis is positive on right
      '   -1.0 ,   0.32 , -0.34 , 1.0 ,
      proc S3D_Project x66, y66, 1.0 , -1.0 , -1.0      
      proc S3D_Project x67, y67, 1.0 , -1.0 , -0.34
      proc S3D_Project x68, y68, 1.0 , -1.0 ,  0.32        
      proc S3D_Project x69, y69, 1.0 , -1.0 , 1.0

      proc S3D_Project x76, y76, 1.0 , -0.34, -1.0
      proc S3D_Project x77, y77, 1.0 , -0.34 , -0.34  
      proc S3D_Project x78, y78, 1.0 , -0.34 ,  0.32  
      proc S3D_Project x79, y79, 1.0 , -0.34 , 1.0

      proc S3D_Project x86, y86, 1.0 , 0.32, -1.0  
      proc S3D_Project x87, y87, 1.0 , 0.32 , -0.34  
      proc S3D_Project x88, y88, 1.0 , 0.32 ,  0.32    
      proc S3D_Project x89, y89, 1.0 , 0.32 , 1.0

      proc S3D_Project x96, y96, 1.0 , 1.0 , -1.0      
      proc S3D_Project x97, y97, 1.0 , 1.0 , -0.34
      proc S3D_Project x98, y98, 1.0 , 1.0 ,  0.32        
      proc S3D_Project x99, y99, 1.0 , 1.0 , 1.0

       ' square 16
     p1[] = [ x66,y66,x67,y67,x77,y77,x76,y76 ]
      proc  MakeColor clr[16]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 17
     p1[] = [ x67,y67,x68,y68,x78,y78,x77,y77 ]
      proc  MakeColor clr[17]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 18
     p1[] = [ x68,y68,x69,y69,x79,y79,x78,y78 ]
      proc  MakeColor clr[18]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 28
     p1[] = [ x76,y76,x77,y77,x87,y87,x86,y86 ]
      proc  MakeColor clr[28]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 29
     p1[] = [ x77,y77,x78,y78,x88,y88,x87,y87 ]
      proc  MakeColor clr[29]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 30
     p1[] = [ x78,y78,x79,y79,x89,y89,x88,y88 ]
      proc  MakeColor clr[30]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1


       ' square 40
     p1[] = [ x86,y86,x87,y87,x97,y97,x96,y96 ]
      proc  MakeColor clr[40]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 41
     p1[] = [ x87,y87,x88,y88,x98,y98,x97,y97 ]
      proc  MakeColor clr[41]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1

       ' square 42
     p1[] = [ x88,y88,x89,y89,x99,y99,x98,y98 ]
      proc  MakeColor clr[42]
       draw poly p1, 1
      set color 0, 0, 0
      draw poly p1




endproc

procedure Bottom()
   ' yellow

endproc

procedure MakeColor(clr2)

     
     if clr2 = 1 then  set color 255,255,255
     if clr2 = 2 then set color 255,0,0
     if clr2 = 3 then set color 0,0,255
     if clr2 = 4 then set color 250,155,0
     if clr2 = 5 then set color 0,255,0
     if clr2 = 6 then set color 255,255,0
   
endproc

end






' JESUS IS COMING....... PASS IT ON

_______________________________________________________________________________________________


Attached Files
.bmp   RrrcubeV2.bmp (Size: 223.06 KB / Downloads: 45)
.txt   TheCube.txt (Size: 32.8 KB / Downloads: 6)
Reply
#8
Hi Rick

Nice work with the cube version 2. [Image: smile.png]
Reply
#9
(07-13-2018, 04:21 PM)pedromartins Wrote: Hi Rick

Nice work with the cube version 2. [Image: smile.png]

 Hello Pedro

 That was one of the hardest programs I've ever tried to make. The only thing harder, is to actually solve one. I may never get that far.
Reply
#10
Very impressive, well done, it's a masterpiece!

I'm terrible at solving these things though Smile  I once saw a dude on tv who examined three highly scrambled cubes for a long long while and then solved them blindfolded!

Edit  This was not the one I saw, but he does the same thing: https://www.youtube.com/watch?v=1EqgeMfJ_rE
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)