home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / clarion / library / pcx3 / paint.cla < prev    next >
Text File  |  1992-08-19  |  11KB  |  376 lines
  1. ! PCX LEM Demo
  2. ! don't expect much, OK?
  3. ! Select icon tool and color with mouse
  4. ! press number keys 0-9 to select a pattern
  5. ! This program uses it's own mouse cursor.
  6. ! Esc quits
  7. ! Right mouse button will start new screen
  8.  
  9. PAINT         PROGRAM
  10.          INCLUDE('STD_KEYS.CLA')
  11.          INCLUDE('PCX3.CPY')
  12.  
  13. SCREEN         SCREEN      PRE(SCR),HUE(7,1)
  14.            ROW(1,1)      PAINT(2,80),HUE(15,0)
  15.            ROW(2,67)  PAINT(24,14),HUE(15,0)
  16.            ROW(24,1)  PAINT(2,66),HUE(15,0)
  17.            ROW(3,1)      PAINT(22,15),HUE(15,0)
  18.            ROW(3,66)  PAINT(21,2),HUE(15,1)
  19.            ROW(2,16)  PAINT(1,52),HUE(15,1)
  20.          COL(16)  STRING('╔═{50}╗'),ENH
  21.            ROW(3,67)  STRING('║'),ENH
  22.            ROW(4,66)  STRING('─╢'),ENH
  23.            ROW(5,67)  REPEAT(18);STRING('║'),ENH .
  24.            ROW(23,66) STRING('═╝'),ENH
  25.            ROW(3,16)  STRING('║'),ENH
  26.            ROW(4,16)  STRING('╟─{49}'),ENH
  27.            ROW(5,16)  REPEAT(18);STRING('║'),ENH .
  28.            ROW(23,16) STRING('╚═{49}'),ENH
  29.            ROW(3,35)  STRING('Select Options')
  30.            ROW(6,30)  STRING('1'),ENH
  31.          COL(31)  STRING('-EGA,')
  32.          COL(37)  STRING('2'),ENH
  33.          COL(38)  STRING('-VGA,')
  34.          COL(44)  STRING('3'),ENH
  35.          COL(45)  STRING('-ET3000,')
  36.          COL(54)  STRING('4'),ENH
  37.          COL(55)  STRING('-ET4000')
  38.            ROW(7,30)  STRING('5'),ENH
  39.          COL(31)  STRING('-Paradise, 6-ATI(')
  40.          COL(48)  STRING('?'),ENH
  41.          COL(49)  STRING('), 7-Video 7(')
  42.          COL(62)  STRING('?'),ENH
  43.          COL(63)  STRING(')')
  44.            ROW(9,30)  STRING('1'),ENH
  45.          COL(31)  STRING('-EPSON,')
  46.          COL(39)  STRING('2'),ENH
  47.          COL(40)  STRING('-HP LASERJET,')
  48.          COL(54)  STRING('3'),ENH
  49.          COL(55)  STRING('-HP Gray')
  50.            ROW(11,30) STRING('A'),ENH
  51.          COL(32)  STRING('- 320x200 16 colors - EGA/VGA/SVGA')
  52.            ROW(12,30) STRING('B'),ENH
  53.          COL(32)  STRING('- 640x200 16 colors - EGA/VGA/SVGA')
  54.            ROW(13,30) STRING('C'),ENH
  55.          COL(32)  STRING('- 640x350 16 colors - EGA/VGA/SVGA')
  56.            ROW(14,30) STRING('D'),ENH
  57.          COL(32)  STRING('- 640x480 16 colors - VGA/SVGA')
  58.            ROW(15,30) STRING('E'),ENH
  59.          COL(32)  STRING('- 800x600 16 colors - SVGA')
  60.            ROW(16,30) STRING('F'),ENH
  61.          COL(32)  STRING('- 320x200 256 colors - VGA/SVGA')
  62.            ROW(17,30) STRING('G'),ENH
  63.          COL(32)  STRING('- 640x400 256 colors - SVGA')
  64.            ROW(18,30) STRING('H'),ENH
  65.          COL(32)  STRING('- 640x480 256 colors - SVGA')
  66.            ROW(19,30) STRING('I'),ENH
  67.          COL(32)  STRING('- 800x600 256 colors - SVGA')
  68.            ROW(20,30) STRING('J'),ENH
  69.          COL(32)  STRING('- 1024x768 256 colors - SVGA')
  70.            ROW(10,49) ENTRY,USE(?FIRST_FIELD3)
  71.            ROW(6,19)  STRING('VCARD  :')
  72.          COL(27)  ENTRY(@N1),USE(VCARD),ENH,SEL(0,7),OVR,REQ,NUM
  73.            ROW(9,19)  STRING('PRINTER:')
  74.          COL(27)  ENTRY(@N1),USE(PRINTER),ENH,SEL(0,7),OVR,REQ,NUM
  75.            ROW(11,19) STRING('VMODE  :')
  76.          COL(27)  ENTRY(@S1),USE(VMODE),ENH,SEL(0,7),OVR,REQ,LFT,UPR
  77.            ROW(22,31) PAUSE('Press Enter to Continue'),USE(?PAUSE_FIELD),ENH
  78.          .
  79.  
  80. VCARD         BYTE                 !TYPE OF VIDEO CARD
  81. PRINTER         BYTE                 !TYPE OF PRINTER
  82. VMODE         STRING(1)                 !VIDEO MODE
  83.  
  84. MODES         SHORT,DIM(10)             !VIDEO MODE ARRAY
  85.  
  86. MOUSE         STRING(50)                 !STRING TO HOLD MOUSE SHAPE
  87. FILE         STRING(40)                 !FILE TO LOAD OR SAVE
  88. BLOBFILE     STRING(40)                 !FILE TO LOAD OR SAVE
  89.  
  90. PAT         STRING(8)                 !VARIABLE CREATED TO CHANGE
  91. PATB         BYTE,DIM(8),OVER(PAT)         ! A DRAWING PATTERN
  92.  
  93. COLOR         SHORT                 !DRAWING COLOR
  94. CCOLOR         SHORT                 !TEMP COLOR
  95. PATTERN         BYTE                 !DRAWING PATTERN
  96. TOOL         BYTE                 !DRAW TOOL
  97. ROW         SHORT                 !TEXT ROW
  98. COL         SHORT                 !TEXT COLUMN
  99.  
  100. WIDTH         SHORT                 !SCREEN WIDTH
  101. DEPTH         SHORT                 !SCREEN HEIGHT
  102.  
  103. X         SHORT                 !mouse variables...must be
  104. Y         SHORT                 ! declared as short
  105. B         SHORT                 !
  106.  
  107. OX         SHORT                 !LAST MOUSE POSITION
  108. OY         SHORT                 !
  109. OB         SHORT                 !
  110.  
  111. XX         SHORT                 !TEMP X
  112. YY         SHORT                 !TEMP Y
  113.  
  114.          CODE
  115.          PATB[1] = 00000000b         !change a default pattern
  116.          PATB[2] = 00111000b
  117.          PATB[3] = 01000100b
  118.          PATB[4] = 10010010b
  119.          PATB[5] = 10101010b
  120.          PATB[6] = 10010010b
  121.          PATB[7] = 01000100b
  122.          PATB[8] = 00111000b
  123.          SETPATTERN(2,PAT)
  124.  
  125.          SETVMEM(2)                 !SVGA 512K
  126.          SETVMONITOR(3)             !SVGA 800X600
  127.          DO GET_INFO             !ASK FOR SCREEN SIZE, PRINTER
  128.  
  129.          COLOR = 15                 !COLOR = BRIGHT WHITE
  130.          PATTERN = 0             !PATTERN = 0
  131.          TOOL = 0                 !TOOL = DRAW
  132.          ROW = 10                 !DEFAULT TEXT ROW
  133.          COL = 30                 !DEFAULT TEXT COLUMN
  134.  
  135.          X = 100                 !DEFAULT X
  136.          Y = 100                 !DEFAULT Y
  137.          B = 0                 !DEFAULT BUTTON STATUS
  138.  
  139.        ! MOUSE = 'R8G2F8G2H8G2U7RD5'     !Standard mouse cursor
  140.          MOUSE = 'R9R9DL9L8D8D9LU9U9'     !CORNER MOUSE CURSOR
  141.  
  142.          MOUSEINIT                 !INITIALIZE MOUSE
  143.  
  144.          LOOP                 !MAIN PROGRAM LOOP
  145.            WINDOW(0,0,WIDTH,DEPTH)         !SET MOUSE AREA
  146.            OX = X                 !SAVE X,Y,B
  147.            OY = Y                 !
  148.            OB = B                 !
  149.  
  150.            SETPOS(OX,OY)                  !SET GRAPHIC CURSOR
  151.            IF TOOL = 7 OR TOOL = 10 OR TOOL = 13  !IF "CUT" OR "SAVE"
  152.          DRAW(MOUSE,256+15)              !DRAW MOUSE ON SCREEN
  153.            ELSE
  154.          BLOB('MOUSE.BLB',OX,OY,1)
  155.            .
  156.  
  157.            LOOP UNTIL OX<>X OR OY<>Y OR OB<>B    !WAIT FOR NEXT MOVEMENT
  158.          GETMPOS(X,Y,B)                 !READ MOUSE POSITION
  159.          IF KEYBOARD() THEN BREAK.
  160.            .
  161.            SETPOS(OX,OY)
  162.            IF TOOL = 7 OR TOOL = 10 OR TOOL = 13
  163.          DRAW(MOUSE,256+15)
  164.            ELSE
  165.          BLOB('MOUSE.BLB',OX,OY,1)
  166.            .
  167.  
  168.            IF KEYBOARD()
  169.          ASK
  170.          IF TOOL = 9             !TEXT MODE
  171.            SETCURSOR(ROW,COL)
  172.            TYPE(CHR(KEYCODE()))
  173.            COL += 1
  174.          ELSIF KEYCODE() >= 48 AND KEYCODE() <= 57   !NUMBER KEYS
  175.            PATTERN = KEYCODE() - 48             !SELECT PATTERN
  176.            DO SHOW_COLORS                 !DRAW PALETTE
  177.          ELSIF KEYCODE() = ESC_KEY THEN BREAK.         !QUIT ON Esc
  178.            .
  179.  
  180.            DO SHOW_XY             !PUT X,Y COORDINATES ON SCREEN
  181.            IF B = 2 THEN DO SET_SCREEN;CYCLE. !CLEAR SCREEN ON RIGHT BUTTON
  182.  
  183.            IF B = 1                 !LEFT BUTTON PRESSED
  184.          IF Y < 20 AND X < 320         !SELECT A COLOR
  185.            COLOR = X/20             !
  186.            DO SHOW_COLORS         !
  187.            CYCLE             !
  188.          ELSIF Y < 40 AND X < 320     !SELECT A TOOL
  189.            T# = X/20             !HOLD TOOL NUMBER
  190.            IF T# = 11 THEN DO LOAD_PCX;CYCLE.
  191.            IF T# = 12 THEN DO SAVE_PCX;CYCLE.
  192.            IF T# = 13 THEN DO SAVE_BLOB.
  193.            IF T# = 14 THEN DO LOAD_BLOB.
  194.            TOOL = T#             !SET NEW TOOL NUMBER
  195.            DO SHOW_COLORS
  196.            CYCLE
  197.          .
  198.          IF Y > 40 THEN DO SET_TOOL.     !CURSOR IN DRAWING AREA
  199.          . .
  200.          SETVMODE(3)             !TEXT MODE
  201.          RETURN
  202.  
  203.  
  204. SET_TOOL ROUTINE
  205.   IF TOOL = 0 THEN DRAWTO(X,Y,COLOR);EXIT.
  206.   IF TOOL = 6 THEN FILL(X,Y,COLOR);EXIT.
  207.   IF TOOL = 8 THEN SETPCX('TEMP.PCX',X,Y,WIDTH(),DEPTH());IF ERROR();BEEP.EXIT.
  208.   IF TOOL = 9 THEN DO SET_ROW_COL;EXIT.
  209.   IF TOOL = 14 THEN BLOB(BLOBFILE,X,Y,2);IF ERROR() THEN BEEP.EXIT.
  210.  
  211.   WINDOW(0,41,WIDTH,DEPTH)
  212.   SETPOS(X,Y)
  213.   XX = X
  214.   YY = Y
  215.   OX = X
  216.   OY = Y
  217.   cCOLOR = COLOR;if COLOR = 0 then COLOR = 15.
  218.   COLOR += 256
  219.   DO TOOL_DRAW
  220.   LOOP
  221.     GETMPOS(X,Y,B)
  222.     IF B = 0 THEN BREAK.
  223.     IF OX = X AND OY = Y THEN CYCLE.
  224.     DO SHOW_XY
  225.     DO TOOL_DRAW
  226.     OX = X
  227.     OY = Y
  228.     DO TOOL_DRAW
  229.   .
  230.   DO TOOL_DRAW
  231.   COLOR = cCOLOR
  232.   OX = X
  233.   OY = Y
  234.   IF TOOL = 7                     !CUT
  235.     SAVEPCX('TEMP.PCX',XX,YY,X,Y)
  236.   ELSIF TOOL = 13
  237.     SAVEBLOB(BLOBFILE,XX,YY,X,Y)
  238.   ELSIF TOOL = 10                 !PRINT
  239.     IF PRINTER = 1 THEN EPDUMP(XX,YY,X,Y,1,0);IF ERROR() THEN STOP(ERROR())..
  240.     IF PRINTER = 2 THEN HPDUMP(XX,YY,X,Y,1,0);IF ERROR() THEN STOP(ERROR())..
  241.     IF PRINTER = 3 THEN output(chr(13));HPDUMP(XX,YY,X,Y,0,256);IF ERROR() THEN STOP(ERROR())..
  242.   ELSE                         !ALL OTHERS
  243.     DO TOOL_DRAW
  244.   .
  245.   WINDOW(0,0,WIDTH,DEPTH)
  246.   EXIT
  247.  
  248. TOOL_DRAW ROUTINE
  249.   EXECUTE TOOL                     !SELECT TOOL FUNCTION
  250.     LINE(XX,YY,OX,OY,COLOR)             !LINE
  251.     FRAME(XX,YY,OX,OY,COLOR)             !FRAME
  252.     BOX(XX,YY,OX,OY,COLOR)             !BOX
  253.     CIRCLE(XX,YY,XX-OX,YY-OY,COLOR)         !CIRCLE
  254.     DISC(XX,YY,XX-OX,YY-OY,COLOR)         !DISC
  255.     FRAME(XX,YY,OX,OY,COLOR)             !FILL(NOT USED HERE)
  256.     FRAME(XX,YY,OX,OY,COLOR)             !CUT
  257.     FRAME(XX,YY,OX,OY,COLOR)             !PASTE(NOT USED HERE)
  258.     FRAME(XX,YY,OX,OY,COLOR)             !TEXT(NOT USED HERE)
  259.     FRAME(XX,YY,OX,OY,COLOR)             !PRINT
  260.     FRAME(XX,YY,OX,OY,COLOR)             !SAVE
  261.     FRAME(XX,YY,OX,OY,COLOR)             !LOAD
  262.     FRAME(XX,YY,OX,OY,COLOR)             !SAVE BLOB
  263.     FRAME(XX,YY,OX,OY,COLOR)             !BLOB
  264.   .
  265.   EXIT
  266.  
  267. LOAD_PCX     ROUTINE
  268.   SETCURSOR(0,0)
  269.   TYPE(ALL(' ',40))
  270.   SETCURSOR(0,0)
  271.   FILE = INPUT('FILE TO LOAD: ')
  272.   SETPCX(FILE,0,41,WIDTH,DEPTH)
  273.   IF ERROR() THEN BEEP.
  274.   DO DRAW_TOOLS
  275.   EXIT
  276.  
  277. SAVE_PCX     ROUTINE
  278.   SETCURSOR(0,0)
  279.   TYPE(ALL(' ',40))
  280.   SETCURSOR(0,0)
  281.   FILE = INPUT('FILE TO SAVE: ')
  282.   SAVEPCX(FILE,0,41,WIDTH,DEPTH)
  283.   IF ERROR() THEN STOP(ERROR()).
  284.   DO DRAW_TOOLS
  285.   EXIT
  286.  
  287. LOAD_BLOB    ROUTINE
  288.   SETCURSOR(0,0)
  289.   TYPE(ALL(' ',40))
  290.   SETCURSOR(0,0)
  291.   BLOBFILE = INPUT('BLOB TO LOAD: ')
  292.   DO DRAW_TOOLS
  293.   EXIT
  294.  
  295. SAVE_BLOB    ROUTINE
  296.   SETCURSOR(0,0)
  297.   TYPE(ALL(' ',40))
  298.   SETCURSOR(0,0)
  299.   BLOBFILE = INPUT('BLOB TO SAVE: ')
  300.   DO DRAW_TOOLS
  301.   EXIT
  302.  
  303. GET_INFO     ROUTINE
  304.   MODES[1] = 13
  305.   MODES[2] = 14
  306.   MODES[3] = 16
  307.   MODES[4] = 18
  308.   MODES[5] = 258
  309.   MODES[6] = 19
  310.   MODES[7] = 256
  311.   MODES[8] = 257
  312.   MODES[9] = 259
  313.   MODES[10] = 261
  314.  
  315.   OPEN(SCREEN)
  316.   SETCURSOR
  317.   DISPLAY
  318.   LOOP
  319.     ACCEPT
  320.     CASE FIELD()
  321.     OF ?FIRST_FIELD3
  322.       IF KEYCODE() = ESC_KEY THEN RETURN.
  323.     OF ?VCARD
  324.       SETVCARD(VCARD)
  325.       IF ERROR() THEN STOP(ERROR());SELECT(?);CYCLE.
  326.     OF ?PRINTER
  327.       IF PRINTER < 1 OR PRINTER > 3 THEN BEEP;SELECT(?);CYCLE.
  328.     OF ?VMODE
  329.       CLOSE(SCREEN)
  330.       SETVMODE(MODES[VAL(VMODE)-64])         !CONVERTS LETTER TO VESA CODE
  331.       IF ERROR() THEN OPEN(SCREEN);BEEP;CYCLE.
  332.       DO SET_SCREEN
  333.       BREAK
  334.   . .
  335.   EXIT
  336.  
  337. SET_SCREEN   ROUTINE
  338.   SETVMODE(MODES[VAL(VMODE)-64])         !CONVERTS LETTER TO VESA CODE
  339.   IF ERROR() THEN STOP(ERROR()).
  340.   WIDTH = WIDTH()
  341.   DEPTH = DEPTH()
  342.   DO DRAW_TOOLS
  343.   EXIT
  344.  
  345.  
  346. SHOW_COLORS ROUTINE
  347.   USEPATTERN(0)
  348.   BOX(1,1,20*16,20,0)
  349.   USEPATTERN(PATTERN)
  350.   LOOP Z# = 0 TO 15
  351.     BOX(Z#*20,0,Z#*20+20,20,Z#)          !DRAW COLORS
  352.     FRAME(Z#*20,0,Z#*20+20,20,7)      !DRAW COLOR BORDERS
  353.     FRAME(Z#*20,20,Z#*20+20,40,7)     !DRAW TOOL BORDERS
  354.   .
  355.   FRAME(COLOR*20,0,COLOR*20+20,20,15) !HIGHLIGHT COLOR
  356.   FRAME(TOOL*20,20,TOOL*20+20,40,15)  !HIGHLIGHT TOOL
  357.   EXIT
  358.  
  359. SET_ROW_COL  ROUTINE
  360.   ROW = Y/16
  361.   COL = X/8 + 1
  362.   EXIT
  363.  
  364. SHOW_XY         ROUTINE
  365.   SETCURSOR(2,34);TYPE(format(X,@p<<#p))
  366.   SETCURSOR(2,38);TYPE(format(Y,@p<<#p))
  367.   EXIT
  368.  
  369. DRAW_TOOLS   ROUTINE
  370.   BLOB('TOOLBAR.BLB',0,0,0)
  371.   if error() then stop(error()).
  372.   LINE(0,40,WIDTH-1,40,7)
  373.   DO SHOW_COLORS
  374.   EXIT
  375.  
  376.