home *** CD-ROM | disk | FTP | other *** search
/ Really Useful CD 1 / ReallyUsefulCD1.iso / extras / progutils / _graphics / clip < prev    next >
Encoding:
Text File  |  1991-05-24  |  9.7 KB  |  362 lines
  1. REM > <Graphics$Dir>.Clip
  2. REM
  3. REM Line clipping code demonstration
  4. REM
  5. REM The algorithm is based on Cohen-Sutherland's
  6. REM
  7. REM First both points are give a 4-bit code
  8. REM dependent on their position as follows:
  9. REM
  10. REM    1001 | 1000 | 1010
  11. REM   ------+------+------
  12. REM    0001 | 0000 | 0010  (0000 is visible window)
  13. REM   ------+------+------
  14. REM    0101 | 0100 | 0110
  15. REM
  16. REM Invisible lines can now easily be rejected
  17. REM when the logical AND of their codes is not 0
  18. REM They need not be clipped if the OR of their
  19. REM codes is 0 (they are completely visible)
  20. REM They must be clipped otherwise, but could
  21. REM be rejected later on after the first clip
  22. REM
  23. REM Status line:
  24. REM
  25. REM   Current operation:
  26. REM
  27. REM     Line can be rejected (outside screen),
  28. REM     processed (possibly partly within screen),
  29. REM     or drawn (line is within screen)
  30. REM
  31. REM   Coordinates:
  32. REM
  33. REM     Current (subdivided) coordinates
  34. REM
  35. REM   Level of subdivision:
  36. REM
  37. REM     Number of times a subdivision had to be made,
  38. REM     at maximum this is equal to the number of
  39. REM     bits resolution in the original coordinates
  40. REM
  41. REM   Line number:
  42. REM
  43. REM     Line which is currently being processed
  44. REM
  45. REM Line colours:
  46. REM
  47. REM   Blue    - original
  48. REM   Red     - rejected
  49. REM   Green   - processing
  50. REM   White   - clipped
  51. REM   Magenta - *visible* screen boundary
  52. REM             clipped lines will always end on this
  53. REM
  54. REM Keys:
  55. REM
  56. REM   Stop the program by depressing <Left Shift>
  57. REM   Speed up displaying by depressing <Shift>
  58. REM
  59. REM Sounds:
  60. REM
  61. REM   A beep is heard whenever underflow is encountered
  62. REM   in the clipping code, the coordinates are corrected
  63. REM
  64. REM Slow down general display to half speed:
  65. REM
  66.       S%=FALSE
  67. REM
  68. REM Display clipping process:
  69. REM
  70.       P%=TRUE
  71. REM
  72. REM Wait between lines:
  73. REM
  74.       W%=TRUE
  75. REM
  76. REM Display graphics, otherwise full speed text only:
  77. REM
  78.       G%=TRUE
  79. REM
  80. :
  81. ON ERROR PRINT REPORT$ : ON : END
  82. :
  83. REM Any 16 colour mode works, but the display
  84. REM looks best in MODE 20 as this has exactly
  85. REM double the resolution of MODE 13
  86. MODE 20
  87. IF MODE<>20 THEN
  88.   MODE 12
  89.   IF MODE<>12 THEN
  90.     MODE 9
  91.     IF MODE<>9 THEN
  92.       REM How low can you go...
  93.     ENDIF
  94.   ENDIF
  95. ENDIF
  96. OFF
  97. :
  98. N%=1
  99. REPEAT
  100.   REM Lines which fit on the display window
  101.   X1%=640+(RND(2560)-1280)
  102.   Y1%=512+(RND(2048)-1024)
  103.   X2%=640+(RND(2560)-1280)
  104.   Y2%=512+(RND(2048)-1024)
  105.   PROCDraw(X1%,Y1%,X2%,Y2%)
  106.   N%+=1
  107. UNTIL INKEY(-4) : REM <Left Shift>
  108. :
  109. END
  110. :
  111. DEF PROCDraw(X1%,Y1%,X2%,Y2%)
  112.   X1%=X1%<<16 : X1%=X1%>>2
  113.   Y1%=Y1%<<16 : Y1%=Y1%>>2 
  114.   X2%=X2%<<16 : X2%=X2%>>2
  115.   Y2%=Y2%<<16 : Y2%=Y2%>>2
  116.   PROCOldCoords(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16)
  117.   PROCPrep(X1%,Y1%,X2%,Y2%,F1%,F2%)
  118.   T1%=F1% OR F2%      : REM Combination
  119.   T2%=F1% EOR F2%     : REM Difference
  120.   T1%=T1% AND NOT T2% : REM Logical intersection
  121.   IF T1%=0 THEN
  122.     IF (F1% OR F2%)=0 THEN
  123.       PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,2,0)
  124.     ELSE
  125.       IF ((F1% OR F2%) AND %0011)<>0 THEN
  126.         PROCClipToX(X1%,Y1%,X2%,Y2%,F1%,F2%)
  127.         PROCPrep(X1%,Y1%,X2%,Y2%,F1%,F2%)
  128.         T1%=F1% OR F2%      : REM Combination
  129.         T2%=F1% EOR F2%     : REM Difference
  130.         T1%=T1% AND NOT T2% : REM Logical intersection
  131.       ENDIF
  132.       IF T1%=0 THEN
  133.         IF ((F1% OR F2%) AND %1100)<>0 THEN
  134.           PROCClipToY(X1%,Y1%,X2%,Y2%,F1%,F2%)
  135.         ENDIF
  136.         REM No need to reject now, would have
  137.         REM been done by the X clipping part
  138.         PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,2,0)
  139.       ELSE
  140.         REM Line is outside boundaries
  141.         PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,0,0)
  142.       ENDIF
  143.     ENDIF
  144.   ELSE
  145.     REM Line is outside boundaries
  146.     PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,0,0)
  147.   ENDIF
  148. ENDPROC
  149. :
  150. DEF PROCPrep(RETURN X1%,RETURN Y1%,RETURN X2%,RETURN Y2%,RETURN F1%,RETURN F2%)
  151.   IF X2%<X1% THEN
  152.     X1%=X1% EOR X2%
  153.     X2%=X1% EOR X2%
  154.     X1%=X1% EOR X2%
  155.     Y1%=Y1% EOR Y2%
  156.     Y2%=Y1% EOR Y2%
  157.     Y1%=Y1% EOR Y2%
  158.   ENDIF
  159.   F1%=0
  160.   IF X1%<(0<<16)   THEN F1%=F1% OR %0001
  161.   IF X1%>(319<<16) THEN F1%=F1% OR %0010
  162.   IF Y1%<(0<<16)   THEN F1%=F1% OR %0100
  163.   IF Y1%>(255<<16) THEN F1%=F1% OR %1000
  164.   F2%=0
  165.   IF X2%<(0<<16)   THEN F2%=F2% OR %0001
  166.   IF X2%>(319<<16) THEN F2%=F2% OR %0010
  167.   IF Y2%<(0<<16)   THEN F2%=F2% OR %0100
  168.   IF Y2%>(255<<16) THEN F2%=F2% OR %1000
  169. ENDPROC
  170. :
  171. DEF PROCClipToX(RETURN X1%,RETURN Y1%,RETURN X2%,RETURN Y2%,F1%,F2%)
  172.   LOCAL X%,Y%,M%
  173.   Y%=Y2%>>1
  174.   Y%-=Y1%>>1 : REM Subdivide Y
  175.   X%=X2%>>1
  176.   X%-=X1%>>1 : REM Subdivide X
  177.   IF X%<>0 THEN
  178.     REPEAT
  179.       IF (F1% AND %0001) THEN
  180.         REM Clip to line X=0
  181.         IF X1%<(0<<16)   THEN X1%+=X% : Y1%+=Y% ELSE X1%-=X% : Y1%-=Y%
  182.         IF (X1%>>16)=0   THEN F1%=F1% AND NOT %0001
  183.       ELSE
  184.         IF (F1% AND %0010) THEN
  185.           REM Clip to line X=319
  186.           IF X1%>(319<<16) THEN X1%-=X% : Y1%-=Y% ELSE X1%+=X% : Y1%+=Y%
  187.           IF (X1%>>16)=319 THEN F1%=F1% AND NOT %0010
  188.         ENDIF
  189.       ENDIF
  190.       IF (F2% AND %0001) THEN
  191.         REM Clip to line X=0
  192.         IF X2%<(0<<16)   THEN X2%+=X% : Y2%+=Y% ELSE X2%-=X% : Y2%-=Y%
  193.         IF (X2%>>16)=0   THEN F2%=F2% AND NOT %0001
  194.       ELSE
  195.         IF (F2% AND %0010) THEN
  196.           REM Clip to line X=319
  197.           IF X2%>(319<<16) THEN X2%-=X% : Y2%-=Y% ELSE X2%+=X% : Y2%+=Y%
  198.           IF (X2%>>16)=319 THEN F2%=F2% AND NOT %0010
  199.         ENDIF
  200.       ENDIF
  201.       Y%=Y%>>1
  202.       X%=X%>>1
  203.       IF X%=0 THEN F1%=F1% AND NOT %0011 : F2%=F2% AND NOT %0011
  204.       M%+=1
  205.       PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,1,M%)
  206.     UNTIL ((F1% OR F2%) AND %0011)=0
  207.   ENDIF
  208.   REM Lines that have only a single pixel on the
  209.   REM boundary X=0 line could have round off errors
  210.   REM This is for X1% only as this is moved
  211.   IF X1%<0 THEN X1%=0
  212.   REM Update old coords for neater display of clip
  213.   PROCOldCoords(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16)
  214. ENDPROC
  215. :
  216. DEF PROCClipToY(RETURN X1%,RETURN Y1%,RETURN X2%,RETURN Y2%,F1%,F2%)
  217.   LOCAL X%,Y%,M%
  218.   X%=X2%>>1
  219.   X%-=X1%>>1 : REM Subdivide X
  220.   Y%=Y2%>>1
  221.   Y%-=Y1%>>1 : REM Subdivide Y
  222.   IF Y%<>0 THEN
  223.     IF Y%<0 THEN Y%=0-Y% : X%=0-X%
  224.     REPEAT
  225.       IF (F1% AND %0100) THEN
  226.         REM Clip to line Y=0
  227.         IF Y1%<(0<<16)   THEN X1%+=X% : Y1%+=Y% ELSE X1%-=X% : Y1%-=Y%
  228.         IF (Y1%>>16)=0   THEN F1%=F1% AND NOT %0100
  229.       ELSE
  230.         IF (F1% AND %1000) THEN
  231.           REM Clip to line Y=255
  232.           IF Y1%>(255<<16) THEN X1%-=X% : Y1%-=Y% ELSE X1%+=X% : Y1%+=Y%
  233.           IF (Y1%>>16)=255 THEN F1%=F1% AND NOT %1000
  234.         ENDIF
  235.       ENDIF
  236.       IF (F2% AND %0100) THEN
  237.         REM Clip to line Y=0
  238.         IF Y2%<(0<<16)   THEN X2%+=X% : Y2%+=Y% ELSE X2%-=X% : Y2%-=Y%
  239.         IF (Y2%>>16)=0   THEN F2%=F2% AND NOT %0100
  240.       ELSE
  241.         IF (F2% AND %1000) THEN
  242.           REM Clip to line Y=255
  243.           IF Y2%>(255<<16) THEN X2%-=X% : Y2%-=Y% ELSE X2%+=X% : Y2%+=Y%
  244.           IF (Y2%>>16)=255 THEN F2%=F2% AND NOT %1000
  245.         ENDIF
  246.       ENDIF
  247.       X%=X%>>1
  248.       Y%=Y%>>1
  249.       IF Y%<=0 THEN F1%=F1% AND NOT %1100 : F2%=F2% AND NOT %1100
  250.       M%+=1
  251.       PROCLine(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16,1,M%)
  252.     UNTIL ((F1% OR F2%) AND %1100)=0
  253.   ENDIF
  254.   REM Lines that have only a single pixel on the
  255.   REM boundary Y=0 line could have round off errors
  256.   REM This is for the lowest Y only as this is moved,
  257.   REM however I don't know at this point which one it is
  258.   IF Y1%<0 THEN Y1%=0
  259.   IF Y2%<0 THEN Y2%=0
  260.   IF X1%<0 THEN X1%=0
  261.   IF X2%<0 THEN X2%=0
  262.   REM Update old coords for neater display of clip
  263.   PROCOldCoords(X1%>>16,Y1%>>16,X2%>>16,Y2%>>16)
  264. ENDPROC
  265. :
  266. DEF PROCLine(X1%,Y1%,X2%,Y2%,C%,M%)
  267.   REM C% = 0 rejected, 1 processing, 2 clipped
  268.   REM M% = variable to print (0..255)
  269.   REM Needs P%, S% and W% as global vars (process, slow, wait)
  270.   CASE C% OF
  271.   WHEN 0
  272.     IF G% THEN
  273.       PROCCLine(X1%,Y1%,X2%,Y2%,1)
  274.       PROCText("Rejecting  "+FNCoords(X1%,Y1%,X2%,Y2%))
  275.       IF W% THEN
  276.         IF S% THEN PROCWait(150) ELSE PROCWait(75)
  277.       ENDIF
  278.     ELSE
  279.       PROCText("Rejecting")
  280.     ENDIF
  281.   WHEN 1
  282.     IF P% THEN
  283.       IF G% THEN
  284.         PROCCLine(X1%,Y1%,X2%,Y2%,2)
  285.         PROCText("Processing "+FNCoords(X1%,Y1%,X2%,Y2%)+" "+STR$(M%))
  286.         IF S% THEN PROCWait(50) ELSE PROCWait(25)
  287.       ELSE
  288.         PROCText("Processing")
  289.       ENDIF
  290.     ENDIF
  291.   WHEN 2
  292.     IF G% THEN
  293.       PROCCLine(X1%,Y1%,X2%,Y2%,7)
  294.       PROCText("Drawing    "+FNCoords(X1%,Y1%,X2%,Y2%))
  295.       IF W% THEN
  296.         IF S% THEN PROCWait(150) ELSE PROCWait(75)
  297.       ENDIF
  298.     ELSE
  299.       PROCText("Drawing")
  300.     ENDIF
  301.     REM Next is just a test to check if
  302.     REM the line was correctly clipped
  303.     PROCPrep(X1%,Y1%,X2%,Y2%,F1%,F2%)
  304.     IF (F1% OR F2%)<>0 THEN
  305.       REM This error should never happen as it
  306.       REM will result in address exceptions later
  307.       ERROR 18,"Error for  "+FNCoords(X1%,Y1%,X2%,Y2%)
  308.     ENDIF
  309.   ENDCASE
  310. ENDPROC
  311. :
  312. DEF PROCCLine(X1%,Y1%,X2%,Y2%,C%)
  313.   REM Needs OX1%,OY1%,OX2%,OY2% as global vars (coords)
  314.   CLS
  315.   OFF
  316.   ORIGIN 320,256
  317.   GCOL 0,5 : REM Magenta
  318.   RECTANGLE 0,0,319<<1,255<<1
  319.   GCOL 0,4 : REM Blue
  320.   LINE OX1%<<1,OY1%<<1,OX2%<<1,OY2%<<1
  321.   GCOL 0,C% : REM Colour
  322.   LINE X1%<<1,Y1%<<1,X2%<<1,Y2%<<1
  323. ENDPROC
  324. :
  325. DEF PROCText(T$)
  326.   REM Needs T% and N% as global vars (text, line)
  327.   PRINTTAB(0,0);T$;STRING$(80-(LEN(T$)+LEN(STR$(N%)))," ");STR$(N%)
  328. ENDPROC
  329. :
  330. DEF FNCoords(X1%,Y1%,X2%,Y2%)
  331.   LOCAL S$
  332.   S$ ="("
  333.   S$+=CHR$(ASC(" ")+(ASC("-")-ASC(" "))*ABS(SGN(X1%<<2)<0))
  334.   S$+=RIGHT$("00000"+STR$(ABS(X1%<<2)),5)
  335.   S$+=","
  336.   S$+=CHR$(ASC(" ")+(ASC("-")-ASC(" "))*ABS(SGN(Y1%<<2)<0))
  337.   S$+=RIGHT$("00000"+STR$(ABS(Y1%<<2)),5)
  338.   S$+=","
  339.   S$+=CHR$(ASC(" ")+(ASC("-")-ASC(" "))*ABS(SGN(X2%<<2)<0))
  340.   S$+=RIGHT$("00000"+STR$(ABS(X2%<<2)),5)
  341.   S$+=","
  342.   S$+=CHR$(ASC(" ")+(ASC("-")-ASC(" "))*ABS(SGN(Y2%<<2)<0))
  343.   S$+=RIGHT$("00000"+STR$(ABS(Y2%<<2)),5)
  344.   S$+=")"
  345. =S$
  346. :
  347. DEF PROCOldCoords(X1%,Y1%,X2%,Y2%)
  348.   REM Set global old coords for first clip and second clip
  349.   OX1%=X1%
  350.   OY1%=Y1%
  351.   OX2%=X2%
  352.   OY2%=Y2%
  353. ENDPROC
  354. :
  355. DEF PROCWait(T%)
  356.   LOCAL D%
  357.   IF NOT INKEY(-1) THEN
  358.     D%=INKEY(T%)
  359.   ENDIF
  360. ENDPROC
  361. :
  362.