5748243 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n tmpshow6.bas
   1: DECLARE SUB PIClear (s$, n!, dfseg!, CurOff!)
   2: DECLARE FUNCTION SmallestOne! (n1!, n2!)
   3: DECLARE SUB OverLaySrn (Bp$)
   4: DECLARE SUB PaletteBar ()
   5: DECLARE SUB MakeGrid (Acuracy!)
   6: DECLARE SUB Solarize (r!, g!, B!)
   7: DECLARE SUB Negative ()
   8: DECLARE SUB Mosaic (sz!)
   9: DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%)
  10: DECLARE SUB ShowBitmap (f$, mde!)
  11: DECLARE FUNCTION FillIn$ (t$, num!)
  12: DECLARE SUB ReadPal (Red%, Green%, Blue%)
  13: DECLARE FUNCTION Exist! (fle$)
  14: CLS
  15: CLEAR , , 15000
  16: '==== All code above the line above this one is ignored ====
  17: CONST Bm2$ = "C:\AVI\BMP1.BMP"
  18: CONST Bmp$ = "C:\AVI\BMP2.BMP"
  19: ShowBitmap Bmp$, 2
  20: OverLaySrn Bm2$
  21: 
  22: SUB ChangePal (Red%, Green%, Blue%, syscolor%)
  23: palmask = &H3C6
  24: palregrd = &H3CF
  25: palregwr = &H3C8
  26: paldata = &H3C9
  27: OUT palmask, &HFF
  28: OUT palregwr, syscolor%
  29: OUT paldata, Red%
  30: OUT paldata, Green%
  31: OUT paldata, Blue%
  32: END SUB
  33: 
  34: FUNCTION Exist (fle$)
  35: OPEN fle$ FOR BINARY AS #4
  36: IF LOF(4) = 0 THEN Exist = 0 ELSE Exist = 1
  37: CLOSE 4
  38: END FUNCTION
  39: 
  40: FUNCTION FillIn$ (t$, num)
  41: FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$
  42: END FUNCTION
  43: 
  44: SUB MakeGrid (Acuracy)
  45: sz = Acuracy
  46: FOR x = 0 TO 320 STEP sz
  47: FOR y = 0 TO 200 STEP sz
  48: c = POINT(x + sz, y)
  49: LINE (x, y)-(x + sz - 1, y + sz - 1), c, B
  50: NEXT y
  51: NEXT x
  52: END SUB
  53: 
  54: SUB Mosaic (sz)
  55: IF sz <= 1 THEN EXIT SUB
  56: FOR x = 0 TO 320 STEP sz
  57: FOR y = 0 TO 200 STEP sz
  58: c = POINT(x, y)
  59: LINE (x, y)-(x + sz - 1, y + sz - 1), c, BF
  60: NEXT y
  61: NEXT x
  62: END SUB
  63: 
  64: SUB Negative
  65: Solarize 255, 255, 255
  66: END SUB
  67: 
  68: SUB OverLaySrn (Bp$)
  69: OPEN Bp$ FOR BINARY AS #1
  70: CONST Inc = 9600
  71: DIM v AS STRING * Inc
  72: pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
  73: pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))
  74: 
  75: 
  76: 
  77: DEF SEG = &HA000
  78: FOR q = 1079 TO SmallestOne(LOF(1), (64000) + 1079) STEP Inc
  79: GET #1, q, v
  80: OPEN "1.TMP" FOR BINARY AS #3
  81: pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
  82: PUT #3, , pt1$
  83: PUT #3, , pt2$
  84: PUT #3, , pt3$
  85: PIClear v, 67, &HA000, x1
  86: PUT #3, , v
  87: CLOSE 3
  88: BLOAD "1.TMP", x1
  89: KILL "1.TMP"
  90: x1 = x1 + Inc
  91: NEXT q
  92: 
  93: END SUB
  94: 
  95: SUB PaletteBar
  96: FOR q = 0 TO 255
  97: LINE (q, 0)-(q, 8), q
  98: NEXT q
  99: END SUB
 100: 
 101: SUB PIClear (s$, n, dfsg, CurOff)
 102: LOCATE 1, 1: PRINT dfsg, CurOff, dfsg + CurOff
 103: IF dfsg <> &HA000 THEN END
 104: FOR q = 1 TO LEN(s$)
 105: DEF SEG = dfsg + q + CurOff
 106: LOCATE 1, 1: PRINT dfsg, CurOff, dfsg + CurOff + q
 107: 
 108: IF ASC(MID$(s$, q, 1)) = n THEN MID$(s$, q, 1) = CHR$(PEEK(0))
 109: NEXT q
 110: 'PIClear$ = s$
 111: DEF SEG = dfsg
 112: END SUB
 113: 
 114: SUB ReadPal (Red%, Green%, Blue%)
 115: palmask = &H3C6
 116: paldata = &H3C9
 117: IF INT(Colr% / 2) = Colr% / 2 THEN Red% = INP(paldata): Green% = INP(paldata): Blue% = INP(paldata)
 118: Red% = INP(paldata)
 119: Green% = INP(paldata)
 120: Blue% = INP(paldata)
 121: END SUB
 122: 
 123: SUB ShowBitmap (f$, mde)
 124: DIM Red AS STRING * 1
 125: DIM Green AS STRING * 1
 126: DIM Blue AS STRING * 1
 127: DIM PicType AS STRING * 1
 128: OPEN f$ FOR BINARY AS #1
 129:   GET #1, 29, PicType
 130: mxcol = ASC(PicType)
 131: SCREEN 13
 132: IF mde = 2 THEN
 133:         FOR i% = 0 TO 255
 134:         GET #1, 55 + (i% * 4), Red
 135:         GET #1, 55 + (i% * 4) + 1, Green
 136:         GET #1, 55 + (i% * 4) + 2, Blue
 137:         CCHex1% = INT(ASC(Red)) / 8
 138:         CCHex2% = INT(ASC(Green)) / 8
 139:         CCHex3% = INT(ASC(Blue)) / 8
 140:         ChangePal CCHex3%, CCHex2%, CCHex1%, i%
 141:         NEXT i%
 142: END IF
 143: DEF SEG = &HA000
 144: DIM v AS STRING * 10000
 145: Inc = 10000
 146: pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
 147: pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))
 148: FOR q = 1079 TO SmallestOne(LOF(1), (64000) + 1079) STEP Inc
 149: GET #1, q, v
 150: OPEN "1.TMP" FOR BINARY AS #3
 151: pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
 152: PUT #3, , pt1$
 153: PUT #3, , pt3$
 154: PUT #3, , pt2$
 155: PUT #3, , v
 156: CLOSE 3
 157: 'LOCATE 1, 1: PRINT x1; Inc; LOF(1)
 158: BLOAD "1.TMP", x1
 159: KILL "1.TMP"
 160: x1 = x1 + Inc
 161: NEXT q
 162: IF mde = 1 THEN
 163:         FOR i% = 0 TO 255
 164:         GET #1, 55 + (i% * 4), Red
 165:         GET #1, 55 + (i% * 4) + 1, Green
 166:         GET #1, 55 + (i% * 4) + 2, Blue
 167:         CCHex1% = INT(ASC(Red)) / 8
 168:         CCHex2% = INT(ASC(Green)) / 8
 169:         CCHex3% = INT(ASC(Blue)) / 8
 170:         ChangePal CCHex3%, CCHex2%, CCHex1%, i%
 171:         NEXT i%
 172: END IF
 173: CLOSE 1, 2, 3
 174: END SUB
 175: 
 176: FUNCTION SmallestOne (n1, n2)
 177: IF n2 < n1 THEN SmallestOne = n2 ELSE SmallestOne = n1
 178: END FUNCTION
 179: 
 180: SUB Solarize (r, g, B)
 181:         FOR i% = 0 TO 255
 182:         ReadPal CCHex3%, CCHex2%, CCHex1%
 183:         ChangePal ABS(CCHex3% - r), ABS(CCHex2% - g), ABS(CCHex1% - B), i%
 184:         NEXT i%
 185: END SUB
 186: 
5748244 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:10:15