home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 471.lha / Blox / Blox.hsb < prev    next >
Encoding:
Text File  |  1991-02-04  |  9.2 KB  |  375 lines
  1.  
  2. RANDOMIZE TIMER
  3. REM $OPTION y+ k40
  4. DEFINT I-N
  5. DEFSNG O-Z
  6. SCREEN 1,640,400,3,4
  7. WINDOW 1,,(0,1)-(639,399),16+32+128+256,1
  8. PALETTE 0,.2,.2,.2
  9. PALETTE 1,.0,0,0
  10. PALETTE 2,.3,.3,.3
  11. PALETTE 3,.4,.4,.4
  12. PALETTE 4,.5,.5,.5
  13. PALETTE 5,.6,.6,.6
  14. PALETTE 6,.7,.7,.7
  15. PALETTE 7,.8,.8,.8
  16.  
  17. COLOR 1,0: CLS
  18. DIM X(24),Y(24),Z%(24)
  19. DIM oX(24),oY(24),oZ%(24)
  20. DIM N1%(36),N2%(36)
  21. DIM X2(24),Y2(24)
  22. DIM Ch%(20)
  23. DIM cx(361),cy(361)
  24. DIM ILBM%(1500),PaletteCode%(1860)
  25.  
  26. FOR i=2 TO 10:Ch%(i)=2:NEXT
  27. Ch%(1)=1: Ch%(9)=1
  28.  
  29. Pi=3.14159: p2=Pi*2: PiD2=Pi/2
  30. Rtod=180/Pi: Dtor=Pi/180: D8=Dtor
  31.  
  32. Pi=3.14159: p16=Pi/180
  33. oangl=45:angl=oangl
  34. 'Compute and store SINE and COSINE
  35. FOR i=0 TO 359
  36. cx(i)=10*SIN(p16*(i+90)):cy(i)=10*COS(p16*(i+90))
  37. NEXT
  38.  
  39.  File$="RAM:Blox.pic"
  40. ' PRINT "Loading machine code"
  41.  BLOAD "ILBM.bcode1",VARPTR(ILBM%(0))
  42.  BLOAD "Palette.bcode1",VARPTR(PaletteCode%(0))
  43.  
  44. ScrnWide=640: ScrnHi=400
  45. Swid2Hi=1.3
  46. YXsc=Swid2Hi*ScrnHi/ScrnWide
  47.  
  48. '***          os = Offset     sc = sc
  49. RESTORE 9000
  50. GOSUB 9000
  51.   X3sc=.1:  Y3sc=.2:  Z3sc=.1
  52.   X3os=0:   Y3os=0:   Z3os=0
  53.   X3rot=0:  Y3rot=0:  Z3rot=0
  54.  
  55.   VP=0:     V=45   '-3*Amax
  56.   
  57.   X2sc=ScrnWide/(Amax*6): Y2sc=X2sc*-YXsc
  58.   X2os=ScrnWide*.5:       Y2os=ScrnHi*.5
  59.  
  60.  ' sc3=1.2: os2=ScrnWide/20: os3=(ScrnWide/20)/X2sc: sc2=1.2: Rot3=.05:  Persp=Amax*.8
  61.  
  62.   FOR i=0 TO 7:LINE(i*10+10,10)-STEP(10,10),i,bf: LINE(i*10+10,10)-STEP(10,10),7,b:NEXT 
  63.  
  64. MENU 1,0,1,"  Keys "
  65. MENU 1,1,1," 1 = Incr depth  2 = Decr depth"
  66. MENU 1,2,1," 3 = Rotate left 4 = Rotate right"
  67. MENU 1,3,1," 5 = Unrotate    6 = Original size"
  68. MENU 1,4,1," 9 = Randomn Draw"
  69. MENU 1,5,1," Left Arrow = Narrower, Right = Wider"
  70. MENU 1,6,1," Up Arrow = Taller, Down = Shorter"
  71. MENU 1,7,1," S = Save Blox.pic to RAM: L = Load Pic"
  72. MENU 1,8,1," Y = Steeple, C = Cuboid,  R = Roof"
  73. MENU 1,9,1," P = Palette,  V = Vanishing Point"
  74. MENU 1,10,1," H = Hardcopy (Print Screen)"
  75. MENU 1,11,1," X = Clear Screen"
  76. MENU 1,12,1," ESC or Q = QUIT"
  77.  
  78. MENU 2,0,1," About "
  79. MENU 2,1,1," If you find this to be a tool"
  80. MENU 2,2,1," of ongoing worth, send $10 to"
  81. MENU 2,3,1,"      Jim Charlsen"
  82. MENU 2,4,1,"  3300 Thatcher Ave. #15"
  83. MENU 2,5,1," Marina del Rey, CA. 90292"
  84.  
  85. MENU 3,0,1," Draw Choices "
  86. MENU 3,1,1,"  Wire-frame "
  87. MENU 3,2,2,"  Solid      "
  88. MENU 3,3,2,"  Front "
  89. MENU 3,4,2,"  Back  "
  90. MENU 3,5,2,"  Top   "
  91. MENU 3,6,2,"  Bottom"
  92. MENU 3,7,2,"  Left  "
  93. MENU 3,8,2,"  Right "
  94. MENU 3,9,1,"  Fuzz  "  
  95. ON MENU GOSUB Cherce
  96. MENU ON
  97.  
  98. 500
  99.   SX=SIN(X3rot): CX=COS(X3rot)
  100.   SY=SIN(Y3rot): CY=COS(Y3rot)
  101.   SZ=SIN(Z3rot): CZ=COS(Z3rot)  
  102.  
  103.   FOR i=1 TO Nnodes
  104.     X3so=X(I)*X3sc+X3os: y3so=Y(I)*Y3sc+Y3os: z3so=Z%(I)*Z3sc+Z3os
  105.     x3xr=X3so: Y3xr=Y3so*CX-Z3so*SX: Z3xr=Z3so*CX+Y3so*SX
  106.     Y3yr=Y3xr: Z3yr=Z3xr*CY-X3xr*SY: X3yr=X3xr*CY+Z3xr*SY
  107.     Z3zr=Z3yr: X3zr=X3yr*CZ-Y3yr*SZ: Y3zr=Y3yr*CZ+X3yr*SZ
  108.     X2t=X3zr*(VP-V)/(Y3zr-V): Y2T=Z3zr*(VP-V)/(Y3zr-V)
  109.     X2(i)=X2t*X2sc+X2os: Y2(I)=Y2t*Y2sc+Y2os
  110.   NEXT
  111.     
  112. 1000 
  113.   WHILE Rand=1
  114.     GOSUB FillBox: IF Ch%(9)=2 THEN GOSUB FuzzBox 
  115.     IF INKEY$>"" THEN Rand=0 ': GOSUB CheckKeys
  116.     X3sc=.25*RND+.01:  Y3sc=RND+.01:  Z3sc=.25*RND+.01
  117.     ox=50+RND*560: oy=40+RND*320
  118.     X3os=(ox-X2os)*.095: Z3os=(oy-Y2os)*-.115
  119.     GOTO 500 
  120.   WEND 
  121.   K$="": xy=MOUSE(0): ox=MOUSE(1): oy=MOUSE(2)
  122.   COLOR,,2: GOSUB DrawBox
  123.   WHILE MOUSE(0)=0 AND MOUSE(1)=ox AND MOUSE(2)=oy
  124.     K$=UCASE$(INKEY$): IF K$>"" THEN ox=ox+.001  
  125.   WEND
  126.   COLOR,,2: GOSUB DrawBox  
  127.   COLOR,,1: GOSUB CheckKeys
  128.   IF MOUSE(0)<>0 THEN COLOR 4:GOSUB DrawIt: WHILE MOUSE(0)<>0:WEND
  129.   X3os=(MOUSE(1)-X2os)*.095: Z3os=(MOUSE(2)-Y2os)*-.115
  130.  GOTO 500
  131.  
  132. DrawIt:
  133.   IF Ch%(1)=2 THEN GOSUB DrawBox
  134.   IF Ch%(2)=2 THEN GOSUB FillBox 
  135.   IF Ch%(9)=2 THEN GOSUB FuzzBox  
  136.  RETURN
  137.  
  138. DrawBox:FOR L=1 TO Nlines: LINE(X2(N1%(L)),Y2(N1%(L)))-(X2(N2%(L)),Y2(N2%(L))): NEXT: RETURN
  139.  
  140. FillBox:
  141.   COLOR,,1
  142.   GOSUB FillBack: GOSUB FillLeft: GOSUB FillRight
  143.   IF X2(2)>X2(3) THEN GOSUB FillLeft
  144.   GOSUB FillTop:  GOSUB FillBot
  145.   IF X2(5)>X2(8) THEN GOSUB FillRight
  146.   IF X2(6)<X2(7) THEN GOSUB FillLeft
  147.   IF Y2(2)<Y2(3) THEN GOSUB FillTop  
  148.   GOSUB FillFront   
  149. RETURN
  150.  
  151. FillBack: IF Ch%(4)<2 THEN RETURN
  152.   COLOR 1: i=1: GOSUB FigXY: i=2: GOSUB FigXY: i=6: GOSUB FigXY: i=5: GOSUB FigXY: AREAFILL
  153.  RETURN
  154.  
  155. FillFront: IF Ch%(3)<2 THEN RETURN
  156.   COLOR 5+Sp: i=3: GOSUB FigXY: i=4: GOSUB FigXY: i=8: GOSUB FigXY: i=7: GOSUB FigXY: AREAFILL
  157.  RETURN
  158.  
  159. FillLeft: IF Ch%(7)<2 THEN RETURN
  160.   COLOR 7: i=2: GOSUB FigXY: i=3: GOSUB FigXY: i=7: GOSUB FigXY: i=6: GOSUB FigXY: AREAFILL
  161.  RETURN
  162.    
  163. FillRight: IF Ch%(8)<2 THEN RETURN
  164.   COLOR 4: i=1: GOSUB FigXY:i=4: GOSUB FigXY: i=8: GOSUB FigXY:i=5: GOSUB FigXY: AREAFILL
  165.  RETURN 
  166.  
  167. FillTop: IF Ch%(5)<2 THEN RETURN
  168.   COLOR 6: FOR i=1 TO 4: GOSUB FigXY: NEXT: AREAFILL
  169.  RETURN
  170.  
  171. FillBot: IF Ch%(6)<2 THEN RETURN
  172.   COLOR 2: FOR i=5 TO 8: GOSUB FigXY: NEXT: AREAFILL
  173.  RETURN
  174.  
  175. FigXY:
  176.   x=X2(N1%(i)): y=Y2(N1%(i))
  177.   IF x<0 THEN x=0
  178.   IF x>638 THEN x=638
  179.   IF y<0 THEN y=0
  180.   IF y>398 THEN y=398
  181.   AREA(x,y)
  182.  RETURN
  183.  
  184. FuzzBox:
  185. FOR L=1 TO Nlines
  186.   X=X2(N1%(L)):  Y=Y2(N1%(L))
  187.   FX=X2(N2%(L)): FY=Y2(N2%(L))
  188.   difX=ABS(Y-FY): difY=ABS(Y-FY)
  189.   dif=difX: IF difY>dif THEN dif=difY
  190.   IF dif=0 THEN dif=.0001
  191.   StX=-(X-FX)/dif: StY=(FY-Y)/dif
  192.   FOR i=0 TO dif
  193.    ac=(POINT(StX*i-1+X,StY*i+Y-1)+POINT(StX*i-1+X,StY*i+Y))+POINT(StX*i-1+X,StY*i+Y+1)
  194.    ac=ac+(POINT(StX*i+X,StY*i+Y-1)+POINT(StX*i+X,StY*i+Y+1))
  195.    ac=ac+(POINT(StX*i+1+X,StY*i+Y-1)+POINT(StX*i+1+X,StY*i+Y))+POINT(StX*i+1+X,StY*i+Y+1)
  196.    ac=ac/8
  197.    PSET(StX*i+X,StY*i+Y),ac
  198.   NEXT
  199. NEXT
  200.  RETURN
  201.    
  202. CheckKeys:
  203.   Rand=0
  204.   IF K$="" THEN K$=UCASE$(INKEY$)
  205.   IF K$>"" THEN
  206.     'IF K$="A" THEN COLOR,,1:GOSUB DrawBox
  207.     IF K$="Q" THEN SYSTEM 
  208.     IF K$="C" THEN GOSUB Cube
  209.     IF K$="H" THEN PCOPY
  210.     IF K$="L" THEN GOSUB LoadPic
  211.     IF K$="P" THEN GOSUB ColorPalette
  212.     IF K$="R" THEN GOSUB Roof
  213.     IF K$="S" THEN GOSUB SavePic
  214.     IF K$="V" THEN GOSUB VanP
  215.     IF K$="Y" THEN GOSUB Spire
  216.     IF K$="X" THEN CLS
  217.     'IF K$="-" THEN X2sc=X2sc+.1  :LOCATE 10,10:?X2sc 
  218.     'IF K$="=" THEN X2sc=X2sc-.1  :LOCATE 10,10:?X2sc
  219.     k=ASC(K$)
  220.     IF K=27 THEN SYSTEM
  221.     IF K=28 AND Z3sc<5 THEN Z3sc=Z3sc*1.02
  222.     IF K=29 AND Z3sc>.0002 THEN Z3sc=Z3sc*.98
  223.     IF K=30 AND X3sc<4 THEN X3sc=X3sc*1.04
  224.     IF K=31 AND X3sc>.0001 THEN X3sc=X3sc*.98
  225.     IF K=49 AND Y3sc<4 THEN Y3sc=Y3sc*1.04
  226.     IF K=50 AND Y3sc>.0001 THEN Y3sc=Y3sc*.98
  227.     IF K=51 AND angl>0 THEN DECR angl: GOSUB GD
  228.     IF K=52 AND angl<90 THEN INCR angl: GOSUB GD
  229.     IF K=53 THEN Angl=oangl: GOSUB GD
  230.     IF K=54 THEN X3sc=.1:  Y3sc=.2:  Z3sc=.1
  231.     IF K=57 THEN Rand=1: RETURN 1000
  232.     ox=2000         
  233.   END IF
  234.  RETURN 
  235.  
  236. VanP: COLOR,,2
  237.   WHILE MOUSE(0)=0: X2os=MOUSE(1): Y2os=MOUSE(2): FOR i=1 TO 2: LINE(X2os-2,Y2os-2)-STEP(4,4),,bf: NEXT: WEND
  238.   WHILE MOUSE(0)<>0:WEND
  239.   COLOR,,1
  240. RETURN
  241.  
  242. Roof:Sp=0: GOSUB Cube: FOR i=1 TO 4:X(I)=.01:  ':Y(I)=0:
  243. NEXT
  244.  RETURN 
  245.  
  246. Spire: GOSUB Cube: FOR i=1 TO 4: X(I)=0.01: Y(I)=.01: NEXT: Sp=1: RETURN
  247.  
  248. Cube:Sp=0: FOR i=1 TO 4: X(I)=oX(I): Y(I)=oY(I): NEXT: RETURN
  249.  
  250. Cherce:
  251.   M0=MENU(0): M1=MENU(1)
  252.   IF M0=3 THEN
  253.     Ch%(M1)=ABS(Ch%(M1)-3)
  254.     MENU 3,M1,Ch%(M1)
  255.   END IF  
  256.  RETURN
  257.  
  258. SavePic:
  259.   BEEP:saveILBM File$,error$:BEEP
  260.   IF error$ <> "" THEN ? error$;"  Click to continue":WHILE MOUSE(0)=0:WEND
  261.  RETURN
  262.  
  263. LoadPic:
  264.   First=1: error$=""
  265.   BEEP:loadILBM File$,0,error$:BEEP
  266.   IF error$ <> "" THEN ? error$;"  Click to continue":WHILE MOUSE(0)=0:WEND 
  267.  RETURN
  268.  
  269. SUB LoadILBM(fichier$,opt&,err$) STATIC
  270.   SHARED Args(),ILBM%()
  271.   err$="": i%=0: n%=0: ErrAd&=0
  272.   file0$=fichier$+CHR$(0)
  273.   ad&=opt& : IF ad&=0 THEN ad&=WINDOW(7)
  274.   loading&=VARPTR(ILBM%(0))
  275.   CALL LOC loading&,SADD(file0$),ad&,VARPTR(ErrAd&)
  276.   REM - the 3 arguments sent to the machine are the filename 
  277.   '   address, the address of the Basic window (or options 1 or 2)
  278.   '   and an address for the possible error message.  
  279.   '   If successful, ErrAd& remains zero
  280.   IF ErrAd& = 0 THEN EXIT SUB
  281.   n%=PEEKB(ErrAd&)
  282.   WHILE n% <> 0
  283.     err$=err$+CHR$(n%)
  284.     i%=i%+1 : n%=PEEKB(ErrAd&+i%)
  285.   WEND
  286.   n%=PEEKB(VARPTR(ILBM%(0))+&H9C3)
  287.   IF n% <> 0 THEN err$=err$+" - dos error "+STR$(n%) 
  288. END SUB
  289.  
  290. SUB saveILBM(fichier$,err$) STATIC
  291.   SHARED Args(),ILBM%(),ColorTable()
  292.   err$="" : i%=0 : n%=0 : ErrAd&=0 
  293.   file0$=fichier$+CHR$(0)
  294.   saving&=VARPTR(ILBM%(0))+&H656
  295.   ar&=VARPTR(Args(0)) : ct&=VARPTR(ColorTable(0))
  296.   CALL LOC saving&,SADD(file0$),WINDOW(7),VARPTR(ErrAd&)
  297.   IF ErrAd& = 0 THEN EXIT SUB
  298.   n%=PEEKB(ErrAd&)
  299.   WHILE n% <> 0
  300.     err$=err$+CHR$(n%)
  301.     i%=i%+1 : n%=PEEKB(ErrAd&+i%)
  302.   WEND
  303.   n%=PEEKB(VARPTR(ILBM%(0))+&H9C3)
  304.   IF n% <> 0 THEN err$=err$+" - dos error "+STR$(n%) 
  305. END SUB
  306.  
  307. ColorPalette: 
  308.   Pal&=VARPTR(PaletteCode%(0))
  309.   CALL LOC Pal&,WINDOW(7)
  310.  RETURN
  311.  
  312. 9000
  313.   Cmin=-.01: Cmax=.01
  314.   READ Nnodes
  315.   FOR i=1 TO Nnodes
  316.     READ X,Y,Z
  317.     X(I)=X: Y(I)=Y: Z%(I)=Z
  318.     oX(I)=X: oY(I)=Y: oZ%(I)=Z
  319.   NEXT
  320.   GOSUB GD
  321.   Cmax=10: Cmin=-10: Amax=10
  322.   RESTORE 20000
  323.   READ Nlines
  324.   FOR i=1 TO Nlines: READ N1%(I), N2%(I): NEXT
  325.  RETURN
  326.  
  327. GD:
  328.   ii=1 
  329.   FOR i=angl TO 359+angl STEP 90
  330.     i2=i: IF i2>359 THEN i2=i-360
  331.     X=cx(i2): Y=cy(i2)
  332.     X(ii)=X:  Y(ii)=Y:  X(ii+4)=X:  Y(ii+4)=Y
  333.     oX(ii)=X: oY(ii)=Y: oX(ii+4)=X: oY(ii+4)=Y
  334.     INCR ii
  335.   NEXT
  336. RETURN
  337.  
  338. 10000
  339.   DATA 8
  340.   DATA -10,-10,10
  341.   DATA -10,10,10
  342.   DATA 10,10,10
  343.   DATA 10,-10,10
  344.   DATA -10,-10,-10
  345.   DATA -10,10,-10
  346.   DATA 10,10,-10
  347.   DATA 10,-10,-10
  348.  
  349. ' *** the "T"
  350.   DATA -5,5,10
  351.   DATA 5,5,10
  352.   DATA 0,5,10
  353.   DATA 0,-5,10
  354.  
  355. 20000
  356.   DATA 12
  357.   DATA 1,2
  358.   DATA 2,3
  359.   DATA 3,4
  360.   DATA 4,1
  361.   DATA 5,6
  362.   DATA 6,7
  363.   DATA 7,8
  364.   DATA 8,5
  365.   DATA 5,1
  366.   DATA 6,2
  367.   DATA 7,3
  368.   DATA 8,4
  369.   
  370. ' *** the "T"
  371.   DATA 9,10
  372.   DATA 11,12
  373.   
  374.  
  375.