home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / canvas.bas < prev    next >
Encoding:
BASIC Source File  |  1988-05-22  |  5.7 KB  |  71 lines
  1. 1     rem Canvas.bas by Charles Adams
  2. 5     DIM O$(5) : O$(0) = "SKETCH" : O$(1) = "LINES" : O$(2) = "LINES..." : O$(3) = "BOXES" : O$(4) = "CIRCLES" : O$ (5) = "ERASE"
  3. 10    DIM C$(2),C%(2) : C$(0) = "RED" : C$(1) = "GREEN" : C$(2) = "BLUE"
  4. 11    CL = 1 : BR = 0
  5. 15    SCREEN 0,5,0 : PENO 1 : OUTLINE 1
  6. 20    PENO 1 : FOR A = 0 TO 31 : PENA A
  7. 30    BOX (9 * A,0;8 + 9 * A,19),1
  8. 40    NEXT A : BOX (287,0;302,19) : PENO 2 : BOX (9*CL,0;8+9*CL,19)
  9. 45    FOR A = 1 TO 18 : PENA A : DRAW (288,A TO 301,A) : NEXT A
  10. 47    PENO 1 : PENA 0 : OUTLINE 1 : BOX (296,0;301,8),1: OUTLINE 0
  11. 50    PENO CL : PENA CL
  12. 100   ASK MOUSE X%,Y%,B% : IF B% = 0 THEN LX = -1 :LB = 0: GOTO 100 ELSE IF LB = 1 THEN 100 ELSE IF Y% < 20 THEN 150
  13. 110   IF MD > 0 THEN 1000 ELSE IF LX < 0 THEN AREA (X%,Y% TO X%+BR,Y% TO X%+BR,Y%+BR TO X%,Y%+BR) : GOTO 120
  14. 112   IF LX < X% THEN GOSUB 2000: GOTO 120
  15. 115   IF LX = X% THEN GOSUB 2100: GOTO 120
  16. 117   GOSUB 2200
  17. 120   LX = X% : LY = Y% : GOTO 100
  18. 150   IF X% > 287 THEN 200 ELSE CH = INT (X%/9) : IF CH > 31 THEN 100
  19. 160   PENO 1 : BOX (9 * CL,0;8 + 9 * CL,19) : PENO 2 : BOX (9 * CH,0;8 + 9 * CH,19) : CL = CH : PENA CL :PENO CL : GOTO 100
  20. 200   IF X% > 296 AND Y% < 8 THEN GOTO 500 : PENA CL : GOTO 100 ELSE WINDOW 4,0,0,130,56,"COLOR" : CMD 4 : ASK RGB CL,C%(0),C%(1),C%(2) : C = 0
  21. 205   LC = 9 : O = 1
  22. 210   OUTLINE 0 : PRINT "R:" : PRINT "G:" : PRINT "B:" : PRINT "EXIT:" : PENO 1 : BOX (81,24;89,31) : FOR A = 0 TO 2 : C = A : LN = 4 * C%(A) : GOSUB 290 : NEXT A
  23. 220   ASK MOUSE X%,Y%,B% : IF B% = 0 THEN 220 ELSE IF X% > 81 AND X% < 89 AND Y% > 24 AND Y% < 31 THEN LB = 1 : GOTO 300
  24. 230   C = INT (Y%/8) : IF C > 2 OR C < 0 THEN 220 ELSE GOSUB 295 : LN = X% - 24 : IF LN < 1 THEN LN = 1 ELSE IF LN > 63 THEN LN = 63
  25. 235   C%(C) = INT (LN/4) : O = 2 : GOSUB 290
  26. 240   RGB CL,C%(0),C%(1),C%(2) : GOTO 220
  27. 290   OUTLINE 1 : PENO O : PENA 1 : BOX (24,8*C;24+LN,7+8*C),1 : PENO 1 : PENA 0 : BOX (25+LN,8*C;89,7+8*C),1 : OUTLINE 0 : RETURN
  28. 295   IF C = LC THEN RETURN ELSE LC = C : OUTLINE 1 : FOR A = 0 TO 2 : PENO (1 - (A=C)) : BOX (24,8*A;89,7+8*A) : NEXT A : OUTLINE 0 : RETURN
  29. 300   CLOSE 4 : CMD 0 : GOTO 100
  30. 500   CLOSE 4 : OX = 0 : OY = 0 : WINDOW 4,0,0,108,124,"OPTIONS" : CMD 4 : PENA 1: PENO 1 : OUTLINE 1
  31. 510   FOR A = 0 TO 5 : PRINT O$(A) : NEXT A : PRINT : PRINT "FILL?": BOX (73,56;81,64),FL : GOSUB 590
  32. 515   PRINT "BRUSH:" BR+1 : BOX (73,64;81,72) : PRINT "LOAD." : BOX (73,72;81,80) : PRINT "SAVE." : BOX (73,80;81,88) : PRINT "EXIT." : BOX (73,88;81,96)
  33. 520   ASK MOUSE X%,Y%,B% : IF B% = 0 THEN LC = 0 : GOTO 520 ELSE IF X% < 74 OR X% > 80 THEN 520
  34. 530   IF Y% > 56 AND Y% < 64 THEN IF LC = 1 THEN 520 ELSE FL = - (FL = 0) : PENA FL :  BOX (73,56;81,64),1 : LC = 1 : GOTO 520
  35. 540   Z = INT (Y%/8) : IF Z = 11 THEN 595 ELSE IF Z = 8 THEN 550 ELSE IF Z = 9 THEN 3000 ELSE IF Z = 10 THEN 4000 ELSE IF Z > 5 THEN 520 ELSE MD = Z : GOSUB 590 : GOTO 520
  36. 550   IF LC = 1 THEN 520 ELSE LC = 1 : BR = BR + 1 + 5 * (BR = 4 ) : PRINT AT (7,9);BR+1 : PRINT : PRINT : PRINT : GOTO 520
  37. 590   FOR A = 0 TO 5 : F = - (MD = A) : PENA F : BOX (73,8*A;81,8*A+8),1 : NEXT A : RETURN
  38. 595   CLOSE 4 : CMD 0 : OUTLINE 0 : PENA CL : LB = 1 : GOTO 100
  39. 1000  IF OX = 0 AND OY = 0 THEN OX = X% : OY = Y% : LB = 1 : OC = PIXEL (X%,Y%) : DRAW (X%,Y%) : GOTO 100
  40. 1005  ON MD GOTO 1050,1010,1020,1030,1040
  41. 1010  LX = OX : LY = OY : OX = X% : OY = Y% : LB = 1 : IF LX < X% THEN GOSUB 2000: GOTO 1015
  42. 1012  IF LX = X% THEN GOSUB 2100 : GOTO 1015 ELSE GOSUB 2200
  43. 1015  GOTO 120
  44. 1020  PENO CL : FOR A = 0 TO BR : BOX (OX+A,OY;X%+A,Y%),FL : BOX (OX,OY+A;X%,Y%+A)
  45. 1025  BOX (OX+A,OY+A;X%+A,Y%+A) : NEXT A : OX = 0 : OY = 0 : LB = 1 : GOTO 100
  46. 1030  R = SQR ((OX - X%)^2 + (OY - Y%)^2) : FOR A = 0 TO BR : CIRCLE (OX,OY),R+A : NEXT A : LB = 1
  47. 1035  PENA OC : DRAW (OX,OY) : PENA CL : PENO CL : IF FL = 1 THEN PAINT (OX,OY),0
  48. 1037  OX = 0 : Z = OY-R-A+1 : OY = 0 : IF Z < 20 THEN 20 ELSE 100
  49. 1040  PENO 0 : PENA 0 : BOX (OX,OY;X%,Y%),1 : PENA CL : OX = 0 : OY = 0 : LB = 1 : GOTO 100
  50. 1050  LB = 1 : LX = OX : LY = OY : IF LX < X% THEN GOSUB 2000 : GOTO 1055
  51. 1052  IF LX = X% THEN GOSUB 2100 : GOTO 1055 ELSE GOSUB 2200
  52. 1055  OX = 0 : OY = 0 : GOTO 120
  53. 2000  IF LY < Y% THEN X1 = LX : X2 = LX : X3 = LX + BR : X4 = X% + BR : X5 = X4 : X6 = X% ELSE X1 = LX + BR : X2 = LX : X3 = LX : X4 = X% : X5 = X% + BR : X6 = X5
  54. 2010  IF LY < Y% THEN Y1 = LY + BR : Y2 = LY : Y3 = LY : Y4 = Y% : Y5 = Y% + BR : Y6 = Y5 ELSE Y1 = LY + BR : Y2 = Y1 : Y3 = LY : Y4 = Y% : Y5 = Y% : Y6 = Y% + BR
  55. 2020  GOTO 2500
  56. 2100  IF LY < Y% THEN Y1 = LY : Y2 = LY : Y3 = LY + BR : Y4 = Y% : Y5 = Y% + BR : Y6 = Y5 ELSE Y1 = LY + BR : Y2 = Y1 : Y3 = LY : Y4 = Y% + BR : Y5 = Y% : Y6 = Y%
  57. 2110  X1 = LX + BR : X2 = LX : X3 = LX : X4 = X% : X5 = X% : X6 = X% + BR
  58. 2120  GOTO 2500
  59. 2200  IF LY < Y% THEN X1 = LX : X2 = LX + BR : X3 = X2 : X4 = X% + BR : X5 = X% : X6 = X% ELSE X1 = LX + BR : X2 = X1 : X3 = LX : X4 = X% : X5 = X% : X6 = X% + BR
  60. 2210  IF LY < Y% THEN Y1 = LY : Y2 = LY : Y3 = LY + BR : Y4 = Y% + BR : Y5 = Y4 : Y6 = Y% ELSE Y1 = LY : Y2 = LY + BR : Y3 = Y2 : Y4 = Y% + BR : Y5 = Y% : Y6 = Y%
  61. 2500  AREA (X1,Y1 TO X2,Y2 TO X3,Y3 TO X4,Y4 TO X5,Y5 TO X6,Y6) : RETURN
  62. 3000  SCNCLR : PRINT "PICTURE TO" : PRINT "LOAD:" : PRINT "<CR> = EXIT" : INPUT N$ : IF N$ = "" THEN 500 ELSE OPEN "I",2,N$
  63. 3005  PRINT "LOADING..." : CMD 0
  64. 3010  FOR A = 0 TO 31 : INPUT #2,R%,G%,B% : RGB A,R%,G%,B% : NEXT A
  65. 3020  FOR A = 20 TO 199 : FOR B = 0 TO 319 : INPUT #2,P% : IF P% > -1 THEN DRAW (B,A),P%
  66. 3030  NEXT B : NEXT A : CLOSE 2 : GOTO 500
  67. 4000  SCNCLR : PRINT "PICTURE TO" : PRINT "SAVE:" : PRINT "<CR> = EXIT" : INPUT N$ : IF N$ = "" THEN 500 ELSE OPEN "O",2,N$
  68. 4005  PRINT "SAVING...": CMD 0
  69. 4010  FOR A = 0 TO 31 : ASK RGB A,R%,G%,B% : PRINT #2,R%,G%,B% : NEXT A
  70. 4020  FOR A = 20 TO 199 : FOR B = 0 TO 319 : P% = PIXEL (B,A) : PRINT #2,P% : NEXT B : NEXT A : CLOSE 2 : GOTO 500
  71.