API tools faq
paste
Advertisement
Guest User

sources PC underground part 1

a guest
Jun 30th, 2023
63
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 235.34 KB | Software | 0 0
raw download clone embed print report
  1. .286
  2. w equ word ptr
  3. b equ byte ptr
  4. surfclen equ 200 ;maximale L„nge der Oberfl„chendef.
  5. Punktelen equ 4*100 ;L„nge des Point-Arrays
  6. anz_fl equ 30 ;maximale Anzahl Fl„chen
  7. anz_eck equ 10 ;maximale Anzahl Ecken
  8. data segment ;externe Variablen aus Pascal-Teil
  9. extrn vz:word ;Gesamt-Tiefe
  10. extrn rotx:Word ;Rotations-Winkel
  11. extrn roty:Word
  12. extrn rotz:word
  13. extrn worldconst:dataptr ;Array mit Punkten
  14. extrn surfcconst:dataptr ;Array mit Oberfl„chendefinitionen
  15. extrn lightsrc:word ;Flag fr Lichtquellenschattierung
  16. extrn fl_sort:word ;Flag fr Fl„chensortierung
  17. extrn fl_ruecken:word ;Flag fr Fl„chenrckenunterdrckung
  18. extrn Texture:Byte ;Flag fr Texturen
  19. extrn Fuellen:Byte ;Flag fr Fllen / Drahtmodell
  20.  
  21. crotx dw 0 ;x-, y- und z-Winkel als Offset auf
  22. croty dw 0 ;den jeweiligen Sinus-Wert
  23. crotz dw 0
  24.  
  25. rotx_x dw 0 ;x,y,z nach x-rot
  26. rotx_y dw 0
  27. rotx_z dw 0
  28. roty_x dw 0 ;nach y-rot
  29. roty_y dw 0
  30. roty_z dw 0
  31. rotz_x dw 0 ;nach z-rot, endgltig
  32. rotz_y dw 0
  33. rotz_z dw 0
  34.  
  35. startpoly dw 0 ;Beginn d. Def. der aktuellen Fl„che
  36.  
  37. Punkte dw Punktelen dup (0);nimmt fertig berechnete Koordinaten auf
  38. Punkteptr dw 0 ;Zeiger im Punkte-Array
  39. Punkte3d dw Punktelen dup (0);nimmt fertige 3d-Koordinaten auf (Textur)
  40. mittel dw anz_fl*2 dup (0) ;Verzeichnis der mittleren z-Werte
  41. mittelptr dw 0 ;Zeiger im Mittel-Array
  42. n dw 0,0,0,0,0,0 ;Normalenvektor 32 Bit
  43. n_betr dw 0 ;Betrag des Normalenvektors
  44.  
  45. extrn sinus:dataptr
  46.  
  47. data ends
  48.  
  49. extrn drawpol:near ;zeichnet Fl„che als Drahtmodell
  50. extrn fillpol:near ;fllt Fl„che
  51. extrn wurzel:near ;berechnet Wurzel von ax
  52.  
  53. getdelta macro ;berechnet die beiden Fl„chenvektoren
  54. mov ax,poly3d[0] ;x: Ursprungsecke
  55. mov delta2[0],ax ;in delta2 zwischenspeichern
  56. sub ax,poly3d[8] ;Differenz zum ersten Punkt bilden
  57. mov delta1[0],ax ;und delta1 fertig
  58.  
  59. mov ax,poly3d[2] ;y: Ursprungsecke
  60. mov delta2[2],ax ;in delta2 zwischenspeichern
  61. sub ax,poly3d[10d] ;Differenz zum ersten Punkt bilden
  62. mov delta1[2],ax ;und delta1 fertig
  63.  
  64. mov ax,poly3d[4] ;z: Ursprungsecke
  65. mov delta2[4],ax ;in delta2 zwischenspeichern
  66. sub ax,poly3d[12d] ;Differenz zum ersten Punkt bilden
  67. mov delta1[4],ax ;und delta1 fertig
  68.  
  69. mov bp,polyn ;letzten Punkt anw„hlen
  70. dec bp
  71. shl bp,3 ;jeweils 8 Byte
  72. mov ax,poly3d[bp] ;x holen
  73. sub delta2[0],ax ;Differerenz bilden
  74. mov ax,poly3d[bp+2] ;y holen
  75. sub delta2[2],ax ;Differerenz bilden
  76. mov ax,poly3d[bp+4] ;z holen
  77. sub delta2[4],ax ;Differerenz bilden
  78. endm
  79.  
  80. setkoord macro quelle,offst ;setzt fertig berechnete Screenkoord
  81. .386
  82. mov ax,quelle ;Koordinate projizieren
  83. cwd
  84. shld dx,ax,7
  85. shl ax,7
  86. idiv cx
  87. add ax,offst ;Bildschirmmitte ist 0/0/0
  88. mov bx,Punkteptr ;im Punkte-Array vermerken
  89. mov Punkte[bx],ax
  90. add Punkteptr,2 ;Array-Zeiger weiter
  91. endm
  92.  
  93. z2cx macro tabofs ;holt z-koordinate nach cx
  94. mov cx,tabofs + 4
  95. add cx,vz ;z-translation drauf
  96. mov bx,mittelptr ;im Mittel-Array vermerken
  97. add mittel[bx],cx
  98. endm
  99.  
  100. xrot macro zkoord,qkoord ;rotiert qkoord um x, speichert in zkoord
  101. .386
  102. mov bp,crotx ;winkel holen
  103. mov bx,[qkoord]
  104. shl bx,3 ;x8, um auf Punkte-Eintr„ge zu allignen
  105. mov Punkteptr,bx
  106.  
  107. sub bx,[qkoord] ;insg. x6, um auf Welt-Eintr„ge zu allignen
  108. sub bx,[qkoord]
  109. add bx,offset worldconst ;auf Welt setzen
  110. mov ax,[bx] ;x holen
  111. mov zkoord,ax ;und unver„ndert setzen
  112.  
  113. mov ax,[bx+2] ;y holen
  114. imul w ds:[bp+60d] ;*cos rotx
  115. shrd ax,dx,14d
  116. mov cx,ax ;in cx sichern
  117. mov ax,[bx+4] ;z holen
  118. imul w ds:[bp] ;*-sin rotx
  119. shrd ax,dx,14d
  120. sub cx,ax
  121. mov zkoord+2,cx ;y wert fertig und setzen
  122.  
  123. mov ax,[bx+2] ;y holen
  124. imul w ds:[bp] ;*sin rotx
  125. shrd ax,dx,14d
  126. mov cx,ax ;sichern in cx
  127. mov ax,[bx+4] ;z holen
  128. imul w ds:[bp+60d] ;*cos rotx
  129. shrd ax,dx,14d
  130. add cx,ax
  131. mov zkoord+4,cx
  132. endm
  133.  
  134. yrot macro zkoord,qkoord ;rotiert qkoord um y, speichert in zkoord
  135. mov bp,croty ;winkel holen
  136. mov ax,qkoord+2 ;y holen
  137. mov zkoord+2,ax ;und unver„ndert setzen
  138.  
  139. mov ax,qkoord ;x holen
  140. imul w ds:[bp+60d] ;*cos roty
  141. shrd ax,dx,14d
  142. mov cx,ax ;in cx sichern
  143. mov ax,qkoord+4 ;z holen
  144. imul w ds:[bp] ;*sin roty
  145. shrd ax,dx,14d
  146. add cx,ax
  147. mov zkoord,cx ;x wert fertig und setzen
  148.  
  149. mov ax,qkoord ;x holen
  150. imul w ds:[bp] ;*-sin roty
  151. shrd ax,dx,14d
  152. mov cx,ax ;sichern in cx
  153. mov ax,qkoord+4 ;z holen
  154. imul w ds:[bp+60d] ;*cos roty
  155. shrd ax,dx,14d
  156. sub ax,cx
  157. mov zkoord+4,ax
  158. endm
  159.  
  160. zrot macro zkoord,qkoord ;rotiert qkoord um z, speichert in zkoord
  161. mov bx,Punkteptr ;Eintragung in 3d-Punkte-Array vorbereiten
  162.  
  163. mov bp,crotz ;winkel holen
  164. mov ax,qkoord+4 ;z holen
  165. mov zkoord+4,ax ;und unver„ndert setzen
  166. mov Punkte3d[bx+4],ax ;auáerdem im 3D-Array merken
  167.  
  168. mov ax,qkoord ;x holen
  169. imul w ds:[bp+60d] ;*cos rotz
  170. shrd ax,dx,14d
  171. mov cx,ax ;in cx sichern
  172. mov ax,qkoord+2 ;y holen
  173. imul w ds:[bp] ;*-sin rotz
  174. shrd ax,dx,14d
  175. sub cx,ax
  176. mov zkoord,cx ;x wert fertig und setzen
  177. mov Punkte3d[bx],cx
  178.  
  179. mov ax,qkoord ;x holen
  180. imul w ds:[bp] ;*sin rotz
  181. shrd ax,dx,14d
  182. mov cx,ax ;sichern in cx
  183. mov ax,qkoord+2 ;y holen
  184. imul w ds:[bp+60d] ;*cos rotz
  185. shrd ax,dx,14d
  186. add cx,ax
  187. mov zkoord+2,cx
  188. mov Punkte3d[bx+2],cx
  189.  
  190. endm
  191.  
  192. get_normal macro ;berechnet Normalenvektor einer Fl„che
  193. mov ax,delta1[2] ;a2*b3
  194. imul delta2[4]
  195. shrd ax,dx,4
  196. mov n[0],ax
  197. mov ax,delta1[4] ;a3*b2
  198. imul delta2[2]
  199. shrd ax,dx,4
  200. sub n[0],ax
  201. mov ax,delta1[4] ;a3*b1
  202. imul delta2[0]
  203. shrd ax,dx,4
  204. mov n[2],ax
  205. mov ax,delta1[0] ;a1*b3
  206. imul delta2[4]
  207. shrd ax,dx,4
  208. sub n[2],ax
  209. mov ax,delta1[0] ;a1*b2
  210. imul delta2[2]
  211. shrd ax,dx,4
  212. mov n[4],ax
  213. mov ax,delta1[2]
  214. imul delta2[0]
  215. shrd ax,dx,4
  216. sub n[4],ax ;Kreuzprodukt (=Normalenvektor) fertig
  217.  
  218. mov ax,n[0] ;x1 ^ 2
  219. imul ax
  220. mov bx,ax
  221. mov cx,dx
  222. mov ax,n[2] ;+x2 ^ 2
  223. imul ax
  224. add bx,ax
  225. adc cx,dx
  226. mov ax,n[4] ;+x3 ^ 2
  227. imul ax
  228. add ax,bx
  229. adc dx,cx ;Summe in dx:ax
  230. push si
  231. call wurzel ;wurzel in ax
  232. pop si
  233. mov n_betr,ax ;Betrag des Normalenvektors fertig
  234. endm
  235.  
  236. light macro ;bestimmt Helligkeit einer Fl„che
  237. mov ax,n[0]
  238. imul l[0] ;Lichtvektor * Normalenvektor
  239. mov bx,ax ;in cx:bx Summe bilden
  240. mov cx,dx
  241. mov ax,n[2]
  242. imul l[2]
  243. add bx,ax
  244. adc cx,dx
  245. mov ax,n[4]
  246. imul l[4]
  247. add ax,bx ;Skalarprodukt fertig in dx:ax
  248. adc dx,cx
  249. idiv l_betr ;durch l_betr divid.
  250.  
  251. mov bx,n_betr ;und durch n_betr
  252. cwd
  253. shld dx,ax,5 ;Werte von -32 bis +32
  254. shl ax,5d
  255. mov bp,startpoly ;Adressierung der Fl„chenfarbe vorbereiten
  256. idiv bx ;Division durch Nenner
  257. inc ax
  258. or ax,ax
  259. js zugewandt ;wenn cos à positiv -> vom Licht abgewandt
  260. xor ax,ax ;also keine Beleuchtung
  261. zugewandt:
  262. sub b polycol,al ;cos<0 -> auf Grundfarbe addieren
  263. endm
  264.  
  265. code segment
  266. assume cs:code,ds:data
  267.  
  268. public drawworld
  269.  
  270. public linecount
  271. public polycol
  272. public polyn
  273. public poly2d
  274. public poly3d
  275. linecount dw 0
  276. polycol dw 3 ;aktuelle Fl„chenfarbe
  277. polyn dw 0 ;Anzahl tats„chlich vorhandener Ecken
  278. poly2d dw anz_eck*4 dup (0) ;Ecken des zu zeichnenden Polygons
  279. poly3d dw anz_eck*4 dup (0) ;3D-Ecken
  280.  
  281. public Txt_Nr
  282. Txt_Nr dw 0 ;Nummer der aktuellen Textur
  283.  
  284. public delta1,delta2
  285. delta1 dw 0,0,0 ;Ebenenvektoren
  286. delta2 dw 0,0,0
  287.  
  288. l dw 11d,11d,11d ;Lichtvektor
  289. l_betr dw 19d ;Betrag des Lichtvektors
  290.  
  291.  
  292. drawworld proc pascal ;zeichnet dreidimensionale Welt
  293. push ds
  294. push es
  295. push bp
  296. lea si,surfcconst ;Oberfl„chen werden durch si adressiert
  297. mov mittelptr,0 ;im Mittel-Array mit 0 anfangen
  298. mov ax,ds:[rotx] ;Winkel holen,
  299. shl ax,1 ;als Speicheroffset umrechnen
  300. add ax,offset sinus
  301. mov crotx,ax ;und in Hilfsvariablen ablegen
  302. mov ax,ds:[roty] ;genauso fr y
  303. shl ax,1
  304. add ax,offset sinus
  305. mov croty,ax
  306. mov ax,ds:[rotz] ;und z
  307. shl ax,1
  308. add ax,offset sinus
  309. mov crotz,ax
  310. npoly: ;Polygon-Schleife
  311. mov startpoly,si ;fr sp„tere Verwendung sichern
  312. add si,2 ;Farbe berspringen
  313. mov cx,[si] ;Anzahl Ecken holen
  314. mov linecount,cx ;Z„hler laden
  315. inc cx ;wegen geschlossener Fl„che
  316. mov w polyn,cx ;in Punkte-Array eintragen
  317. add si,2 ;weiter auf eigentliche Koordinaten
  318.  
  319. nline:
  320. xrot rotx_x,si ;koordinaten rotieren um x
  321. yrot roty_x,rotx_x ;um y
  322. zrot rotz_x,roty_x ;und um z
  323. z2cx rotz_x ;z start holen
  324.  
  325. setkoord rotz_x,160 ;Koordinaten schreiben
  326. setkoord rotz_y,100
  327.  
  328. add si,2 ;n„chste Eckpunkt
  329. dec linecount ;Linienz„hler weiter
  330. je polyok ;alle gezeichnet -> Schluss
  331. jmp nline ;sonst n„chste Linie
  332.  
  333. polyok:
  334. mov bx,mittelptr ;Mittelwert errechnen:
  335. mov ax,mittel[bx] ;Summe holen
  336. mov cx,polyn
  337. dec cx
  338. cwd
  339. div cx ;und durch Anzahl Ecken teilen
  340. mov mittel[bx],ax ;zurckschreiben
  341. mov ax,startpoly ;auch "Nummer" der Fl„che schreiben
  342. mov mittel[bx+2],ax
  343. add mittelptr,4 ;und weiter
  344. cmp w [si+2],0 ;alle Polygone fertig ?
  345. je fertig
  346. jmp npoly
  347.  
  348. fertig:
  349. cmp b fl_sort,0 ;Fl„chen sortieren ?
  350. je kein_quicksort
  351. call quicksort pascal,0,bx ;Feld von 0 bis aktuelle Position sortieren
  352.  
  353. kein_quicksort:
  354. mov mittel[bx+4],0 ;Abschluss setzen
  355. mov ax,cs ;Zielsegment setzen
  356. mov es,ax
  357. xor bx,bx ;mit erster Fl„che beginnen
  358. npoly_draw:
  359. lea di,poly2d ;Ziel:Poly-Array
  360. mov bp,mittel[bx+2] ;Zeiger auf Farbe und Punkte der Fl„che holen
  361. mov ax,ds:[bp] ;Farbe holen und setzen
  362. mov polycol,ax
  363.  
  364. mov texture,0 ;Annahme: keine Textur
  365. cmp ah,0ffh ;Textur ?
  366. jne keine_textur
  367. mov texture,1 ;ja, dann setzen
  368. mov b txt_nr,al ;Nummer merken
  369.  
  370. keine_textur:
  371. mov b lightsrc,0 ;Annahme: keine Schattierung
  372. cmp ah,0feh ;Schattierung ?
  373. jne keine_Lichtquelle
  374. mov b lightsrc,1 ;ja, dann setzen
  375.  
  376. keine_Lichtquelle:
  377. add bp,2 ;auf Anzahl positionieren
  378. mov cx,ds:[bp] ;Anzahl Ecken holen
  379. mov polyn,cx ;in Poly-Array schreiben
  380. npoint:
  381. add bp,2
  382. mov si,ds:[bp] ;Zeiger auf tats„chl. Punkt holen
  383. shl si,3 ;3 Word Eintr„ge !
  384. add si,offset Punkte ;und x/y von Punkte-Array in Poly-Koord.
  385.  
  386. mov ax,[si+Punkte3d-Punkte] ;3d-x holen
  387. mov es:[di+poly3d-poly2d],ax ;3d-x setzen
  388. mov ax,[si+Punkte3d-Punkte+2] ;3d-y holen
  389. mov es:[di+poly3d-poly2d+2],ax;3d-y setzen
  390. mov ax,[si+Punkte3d-Punkte+4] ;3d-z holen
  391. mov es:[di+poly3d-poly2d+4],ax;3d-z setzen
  392.  
  393. movsw ;2D-Koordinaten setzen
  394. movsw
  395.  
  396. add di,4 ;n„chsten Poly2d-Eintrag
  397. dec cx ;alle Ecken ?
  398. jne npoint
  399.  
  400. mov bp,polyn ;erste Ecke auf letzte kopieren
  401. shl bp,3 ;auf ersten Punkt positionieren
  402. neg bp
  403. mov ax,es:[di+bp] ;und kopieren
  404. mov es:[di],ax
  405. mov ax,es:[di+bp+2]
  406. mov es:[di+2],ax
  407.  
  408. add di,poly3d-poly2d ;das gleiche fr 3d-Koordinaten
  409. mov ax,es:[di+bp] ;und kopieren
  410. mov es:[di],ax
  411. mov ax,es:[di+bp+2]
  412. mov es:[di+2],ax
  413. mov ax,es:[di+bp+4]
  414. mov es:[di+4],ax
  415.  
  416. cmp fuellen,1 ;Fl„che fllen ?
  417. jne lines
  418.  
  419. getdelta ;ja, dann Delta1 und 2 berechnen
  420. cmp b lightsrc,0 ;Lichtquelle ?
  421. jne schattiere
  422. jmp kein_licht
  423.  
  424. schattiere: ;ja,
  425. push bx
  426. get_normal ;dann Normalenvektor
  427. light ;und Helligkeit berechnen
  428. pop bx
  429.  
  430. kein_licht:
  431. inc polyn ;Anzahl Ecken erh”hen
  432. call fillpol ;Fl„che zeichnen
  433.  
  434. next:
  435. add bx,4 ;n„chste Fl„che anpeilen
  436. cmp mittel[bx],0 ;letzte ?
  437. je _npoly_draw ;nein, dann weiter
  438. jmp npoly_draw
  439.  
  440. lines:
  441. push bx
  442. call drawpol ;Polygon zeichnen
  443. pop bx
  444. jmp next
  445.  
  446. _npoly_draw:
  447. pop bp ;und fertig
  448. pop es
  449. pop ds
  450. ret
  451. drawworld endp
  452.  
  453.  
  454. public quicksort
  455. quicksort proc pascal unten,oben:word
  456. ;sortiert Mitten-Array nach Quicksort-Algorithmus
  457.  
  458. local schluessel:word
  459. local links:word
  460. push bx
  461. mov bx,unten ;Mitte finden
  462. add bx,oben
  463. shr bx,1
  464. and bx,not 3 ;auf 4er Bl”cke posit
  465. mov dx,mittel[bx] ;Schluessel holen
  466. mov schluessel,dx
  467. mov ax,unten ;rechts und links mit Grundwerten init.
  468. mov si,ax
  469. mov links,ax
  470. mov ax,oben
  471. mov di,ax
  472.  
  473. mov dx,schluessel
  474. links_naeher:
  475. cmp mittel[si],dx ;grӇer als Schluessel -> weitersuchen
  476. jbe links_dran
  477. add si,4 ;auf n„chsten posit
  478. jmp links_naeher ;und den berprfen
  479. links_dran:
  480. cmp mittel[di],dx ;kleiner als Schluessel -> weitersuchen
  481. jae rechts_dran
  482. sub di,4 ;auf n„chsten posit
  483. jmp links_dran ;und den berprfen
  484. rechts_dran:
  485. cmp si,di ;links <= rechts ?
  486. jg end_schl ;nein -> Teilbereich fertig sortiert
  487. mov eax,dword ptr mittel[si] ;Mittelwerte und Positionen tauschen
  488. xchg eax,dword ptr mittel[di]
  489. mov dword ptr mittel[si],eax
  490.  
  491. add si,4 ;Zeiger weiterbewegen
  492. sub di,4
  493. end_schl:
  494. cmp si,di ;links > rechts, dann weitermachen
  495. jle links_naeher
  496. mov links,si ;links sichern, wg. Rekursion
  497. cmp unten,di ;unten < rechts -> linken Teilbereich sort.
  498. jge rechts_fertig
  499. call quicksort pascal,unten,di;rekursiv h„lften weiter sortieren
  500. rechts_fertig:
  501. mov si,links ;oben > links -> rechten Teilbereich sort.
  502. cmp oben,si
  503. jle links_fertig
  504. call quicksort pascal,si,oben ;rekursiv h„lften weiter sortieren
  505. links_fertig:
  506. pop bx
  507. ret
  508. quicksort endp
  509.  
  510. code ends
  511. end.286
  512. b equ byte ptr
  513. w equ word ptr
  514.  
  515. data segment
  516. extrn vpage:word ;aktuelle Bildschirmseite
  517. data ends
  518.  
  519. putpixel macro ;setzt Pixel an ax/bx
  520. pusha
  521. xchg ax,bx ;x und y vertauschen
  522. push ax ;y fr sp„ter sichern
  523. mov cx,bx ;x holen
  524. and cx,3 ;Plane maskieren
  525. mov ax,1 ;und entspr. Bit setzen
  526. shl ax,cl
  527. mov ah,2 ;TS Register 2
  528. xchg ah,al
  529. mov dx,3c4h
  530. out dx,ax
  531.  
  532. pop cx ;y holen
  533. mov ax,80d ;Zeilen-Offset berechnen
  534. mul cx
  535. shr bx,2 ;Spalten-Offset addieren
  536. add bx,ax
  537. add bx,vpage ;auf aktuelle Seite schreiben
  538. mov b es:[bx],3 ;und Farbe setzen
  539.  
  540. popa
  541. endm
  542.  
  543. code segment public
  544. assume cs:code,ds:data
  545.  
  546. public bline
  547. bline proc near
  548. ;zieht Linie von ax/bx nach cx/dx
  549. push bp
  550. push ax ;x0 und
  551. push bx ;y0 sichern
  552. mov bx,4340h ;Selbstmodifikation vorbereiten
  553. sub cx,ax ;deltax berechnen
  554. jns deltax_ok ;negativ ?
  555. neg cx ;ja, dann deltax Vorzeichen umkehren
  556. mov bl,48h ;und dec ax statt inc ax
  557. deltax_ok:
  558. mov bp,sp ;Addressierung von y1 auf dem Stack
  559. sub dx,ss:[bp] ;deltay berechnen
  560. jns deltay_ok ;negativ ?
  561. neg dx ;ja, dann deltay Vorzeichen umkehren
  562. mov bh,4bh ;und dec bx statt inc bx
  563. deltay_ok:
  564. mov si,dx ;deltay und
  565. or si,cx ;deltax = 0 ?
  566. jne ok
  567. add sp,6 ;dann ax, bx und bp vom Stack und Ende
  568. ret
  569. ok:
  570. mov w cs:dist_pos,bx ;dec/inc ax/bx an Ziel schreiben
  571. cmp cx,dx ;deltax >= deltay ?
  572. jge deltax_gross
  573. xchg cx,dx ;nein, dann deltax und deltay tauschen
  574. mov bl,90h ;und inc ax noppen
  575. jmp konstanten
  576. deltax_gross:
  577. mov bh,90h ;sonst inc bx noppen
  578. konstanten:
  579. mov w cs:dist_neg,bx ;dec/inc ax/bx an Ziel schreiben
  580. shl dx,1 ;Add_2 bestimmen
  581. mov di,dx ;in di sichern
  582. sub dx,cx ;Start-Dist bestimmen
  583. mov bp,dx ;und in bp sichern
  584. mov si,bp ;Add_1 bestimmen
  585. sub si,cx ;und in si sichern
  586. mov ax,0a000h ;VGA-Segment laden
  587. mov es,ax
  588. pop bx ;gesicherte Werte fr x0 und y0 zurckholen
  589. pop ax
  590. loop_p:
  591. putpixel ;Punkt setzen
  592. or bp,bp ;Dist positiv ?
  593. jns dist_pos
  594. dist_neg:
  595. inc ax ;x weiter (evtl Selbstmodifikation)
  596. inc bx ;y weiter (evtl Selbstmodifikation)
  597. add bp,di ;Dist aktualisieren
  598. loop loop_p ;n„chsten Punkt
  599. jmp fertig ;danach fertig
  600. dist_pos:
  601. inc ax ;x weiter (evtl Selbstmodifikation)
  602. inc bx ;y weiter (evtl Selbstmodifikation)
  603. add bp,si ;Dist aktualisieren
  604. loop loop_p ;n„chsten Punkt
  605. fertig:
  606. pop bp
  607. ret
  608. bline endp
  609. code ends
  610. endextrn waitretrace:far
  611. data segment public
  612. maxrow dw (?)
  613. data ends
  614.  
  615. code segment public
  616. public makecopper
  617.  
  618. assume cs:code,ds:data
  619.  
  620. MakeCopper proc pascal y_pos1,y_pos2,overlay_maske:word
  621. ; Zeichnet 2 Copperbalken an Positionen y_pos1 (rot) und y_pos2 (gruen)
  622. ; overlay_maske: 0ff00h : Copper 2 im Vordergrund
  623. ; 000ffh : Copper 1 im Vordergrund
  624. ; 00000h : Durchdringung beider Copper
  625.  
  626. hoehe equ 88 ;Gesamth”he je Copper
  627.  
  628.  
  629. mov ax,y_pos1 ;maximale y-Koordinate bestimmen
  630. cmp ax,y_pos2
  631. ja ax_high
  632. mov ax,y_pos2
  633. ax_high:
  634. add ax,hoehe ;H”he drauf
  635. mov maxrow,ax ;maximale Zeile, die beachtet werden muá
  636.  
  637. xor cx,cx ;Zeilenz„hler mit 0 starten
  638.  
  639. call waitretrace ;auf Retrace warten zur Synchronisation
  640.  
  641. next_line:
  642. inc cx ;Zeilenz„hler hochz„hlen
  643.  
  644. mov bx,cx ;Farbe 1 berechnen
  645. sub bx,y_pos1 ;dazu Position relativ zum Copperstart holen
  646. cmp bx,hoehe/2 -1 ;schon 2. H„lfte ?
  647. jle copper1_up
  648. sub bx,hoehe -1 ;dann bx:=127-bx
  649. neg bx
  650. copper1_up:
  651. or bx,bx
  652. jns copper1_ok ;positiv, dann Farbe
  653. xor bl,bl
  654. copper1_ok:
  655. mov ax,cx ;Farbe 2 berechnen
  656. sub ax,y_pos2 ;Position relativ berechnen
  657. cmp ax,hoehe/2 -1 ;2. H„lfte
  658. jle copper2_up
  659. sub ax,hoehe -1 ;dann ax:=127-ax
  660. neg ax
  661. copper2_up:
  662. or ax,ax ;positiv, dann Farbe
  663. jns copper2_ok
  664. xor al,al
  665. copper2_ok:
  666. mov bh,al ;bl hat jetzt Farbe Copper 1 / bh Copper 2
  667.  
  668. mov ax,bx ;Overlay berechnen
  669. and ax,overlay_maske ;Copper 1 oder 2 ausmaskieren
  670. or al,al ;Copper 1 Vorrang
  671. je Copper1_hinten
  672. xor bh,bh ;dann Copper 2 l”schen
  673. copper1_hinten:
  674. or ah,ah ;Copper 2 Vorrang
  675. je Copper2_hinten
  676. xor bl,bl ;dann Copper 1 l”schen
  677. copper2_hinten:
  678.  
  679. xor al,al ;Farbe 0 im DAC selektieren
  680. mov dx,3c8h
  681. out dx,al
  682.  
  683. or bl,bl ;wenn Copper 1 schwarz -> lassen
  684. je bl_0
  685. add bl,(128-hoehe) / 2 ;sonst aufhellen, um Maximalhelligkeit
  686. bl_0: ;zu erreichen
  687. or bh,bh ;fr Copper 2 das Gleiche
  688. je bh_0
  689. add bh,(128-hoehe) / 2
  690. bh_0:
  691.  
  692. ;jetzt auf horizontalen Retrace warten und Copper aktivieren
  693.  
  694. cli ;Interrupts l”schen, da SEHR zeitkritisch
  695. mov dx,3dah ;Input Status Register 1 selektieren
  696. in_retrace:
  697. in al,dx ;auf Display warten
  698. test al,1
  699. jne in_retrace
  700.  
  701. in_display:
  702. in al,dx ;Warten auf (Horizontal-) Retrace
  703. test al,1
  704. je in_display
  705.  
  706. mov al,bl ;Farbe 1 laden
  707. mov dx,3c9h ;und setzen
  708. out dx,al ;Rot-Anteile fr Copper 1 setzen
  709. mov al,bh
  710. out dx,al ;Gruen-Anteile fr Copper 2 setzen
  711. xor al,al
  712. out dx,al
  713.  
  714. cmp cx,maxrow ;letzte Zeile erzeugt ?
  715. jne next_line
  716.  
  717. mov dx,3dah ;ja -> beenden
  718. wait_hret: ;vor dem Abschalten, unbedingt auf Retrace
  719. in al,dx ;warten, sonst Flimmern in letzter Zeile
  720. test al,1
  721. je wait_hret
  722.  
  723. xor al,al ;Farbe 0 im DAC selektieren
  724. mov dx,3c8h
  725. out dx,al
  726. inc dx ;alle auf 0 setzen: schwarz
  727. out dx,al
  728. out dx,al
  729. out dx,al
  730.  
  731. sti
  732. ret
  733. makecopper endp
  734. code ends
  735. end
  736. data segment public
  737. extrn colors:word
  738. data ends
  739.  
  740. code segment public
  741. assume cs:code,ds:data
  742. public fade_set,fade_ResetPic
  743.  
  744.  
  745. col db 0 ;Codesegment-Pendant zu Colors
  746.  
  747.  
  748. fade_set proc pascal near quelle:dword, start:word, y:word, hoehe:word
  749. mov ax,colors ;Colors in Code-Segment Variable col eintragen
  750. mov col,al
  751. push ds
  752. mov ax,word ptr Quelle + 2 ;Quellzeiger nach ds:si
  753. mov ds,ax
  754. mov si,word ptr Quelle
  755.  
  756. mov ax,320 ;Startadresse innerhalb des Quellbilds dazu
  757. mul start
  758. add si,ax
  759.  
  760. mov ax,0a000h ;Zielzeiger 0a000:0 nach es:di
  761. mov es,ax
  762. mov ax,320 ;Startadresse innerhalb des Zielbilds dazu
  763. mul y
  764. mov di,ax
  765.  
  766. mov ax,320 ;Hoehe in Anzahl Bytes umrechnen
  767. imul hoehe
  768. mov cx,ax
  769.  
  770. lp: ;Hauptschleife
  771. lodsb ;Zielwert in al
  772. mul col ;neuen Farbwert berechnen
  773. add al,es:[di] ;aktueller Wert in draufaddieren
  774. add al,col
  775. stosb ;und zurckschreiben
  776.  
  777. dec cx ;alle Punkte kopiert ?
  778. jne lp
  779.  
  780. pop ds
  781. ret
  782. fade_set endp
  783.  
  784. fade_ResetPic proc pascal far y:word, hoehe:word
  785. mov ax,0a000h ;VGA-Adresse 0a000:0 nach es:di
  786. mov es,ax
  787.  
  788. mov ax,320 ;Zeile y bercksichtigen
  789. mul y
  790. mov di,ax
  791.  
  792. mov ax,320 ;Anzahl zu bearbeitender Bytes berechnen
  793. mul hoehe
  794. mov cx,ax
  795. res_lp:
  796. mov al,es:[di] ;Wert holen
  797. xor ah,ah ;ah bei Division l”schen !
  798. div byte ptr colors ;Blocknummer berechnen
  799. dec al ;Reset-Block rausnehmen
  800. stosb ;zurckschreiben
  801.  
  802. dec cx ;alle Punkte fertig ?
  803. jne res_lp ;nein, dann weiter
  804.  
  805. ret
  806. fade_ResetPic endp
  807.  
  808. code ends
  809. end
  810. .286
  811.  
  812. clr=256 ;Code fr "Alphabet l”schen"
  813. eof=257 ;Code fr "Datei-Ende"
  814. w equ word ptr
  815. b equ byte ptr
  816.  
  817. data segment public
  818. extrn gifname:dataptr ;Name der Gif-Datei, incl. ".gif" + db 0
  819. extrn vscreen:dword ;Zeiger auf Zielspeicherbereich
  820. extrn palette:dataptr ;Zielpalette
  821. extrn vram_pos:word ;Position innerhalb des Bildschirmspeichers
  822. extrn rest:word ;Rest, der noch kopiert werden muá
  823. extrn errornr:word; ;Flag fr Fehler
  824.  
  825. handle dw 0 ;DOS-Handle fr Gif-Datei
  826. Puf db 768 dup (0) ;Puffer der eingelesenen Daten
  827. PufInd dw 0 ;Zeiger innerhalb dieses Puffers
  828. abStack db 1281 dup (0) ;Stack, zum Entschlsseln eines Bytes
  829. ab_prfx dw 4096 dup (0) ;Alphabet, Pr„fix-Teil
  830. ab_tail dw 4096 dup (0) ;Alphabet, Postfix-Teil
  831. free dw 0 ;n„chste freie Position im Alphabet
  832. breite dw 0 ;Anzahl Bit eines Bytes
  833. max dw 0 ;Maximale Alphabet-L„nge bei akt. Breite
  834. stackp dw 0 ;Zeiger innerhalb des Alphabet-Stacks
  835. restbits dw 0 ;Anzahl noch zu lesender Bit
  836. restbyte dw 0 ;Anzahl noch vorhandener Byte im Puffer
  837. sonderfall dw 0 ;Zwischenspeicher fr den Sonderfall
  838. akt_code dw 0 ;gerade bearbeiteter Code
  839. old_code dw 0 ;vorhergehender Code
  840. readbyt dw 0 ;gerade gelesenes Byte
  841. lbyte dw 0 ;zuletzt gelesenes physikalisches Byte
  842. data ends
  843.  
  844. extrn p13_2_modex:far ;wird beim šberlauf ben”tigt
  845.  
  846. code segment public
  847. assume cs:code,ds:data
  848.  
  849. public readgif
  850. GifRead proc pascal n:word
  851. ;liest n physikalische Bytes aus Datei
  852. mov ax,03f00h ;Funktion 3fh von Interrupt 21h: Lesen
  853. mov bx,handle ;Handle laden
  854. mov cx,n ;Anzahl zu lesender Bytes laden
  855. lea dx,puf ;Zeiger auf Zielpuffer
  856. int 21h ;Interrupt ausfhren
  857. ret
  858. gifread endp
  859.  
  860. GifOpen proc pascal
  861. ;”ffnet die Gif-Datei zum Lese-Zugriff
  862. mov ax,03d00h ;Funktion 3dh: ™ffnen
  863. lea dx,gifname + 1 ;Zeiger auf Namen (L„ngenbyte berspringen)
  864. int 21h ;ausfhren
  865. mov handle,ax ;Handle sichern
  866. ret
  867. gifopen endp
  868.  
  869. GifClose proc pascal
  870. ;schlieát Gif-Datei
  871. mov ax,03e00h ;Funktion 3eh: Schlieáen
  872. mov bx,handle ;Handle laden
  873. int 21h ;ausfhren
  874. ret
  875. gifclose endp
  876.  
  877. GifSeek proc pascal Ofs:dword
  878. ;Positionierung innerhalb der Datei
  879. mov ax,04200h ;Funktion 42h,
  880. mov bx,w handle ;Unterfunktion 0: Seek rel. zu Dateianfang
  881. mov cx,word ptr Ofs + 2 ;Offset laden
  882. mov dx,word ptr Ofs
  883. int 21h ;ausfhren
  884. ret
  885. Endp
  886. ShiftPal proc pascal
  887. ;gleicht das 24-Bit Palettenformat an das 18-Bit VGA-Format an
  888. mov ax,ds ;Quell- und Zielarrays im Datensegment
  889. mov es,ax
  890. mov si,offset Puf ;Lesen aus Datenpuffer
  891. lea di,palette ;Schreiben in Palette
  892. mov cx,768d ;786 Byte kopieren
  893. @l1:
  894. lodsb ;Byte holen
  895. shr al,2 ;konvertieren
  896. stosb ;und schreiben
  897. loop @l1
  898. ret
  899. Endp
  900. FillPuf proc pascal
  901. ;liest einen Block aus der Datei in Puf
  902. call gifread pascal,1 ;ein Byte lesen
  903. mov al,b puf[0] ;L„nge nach al laden
  904. xor ah,ah
  905. mov w restbyte,ax ;und in RestByte sichern
  906. call gifread pascal, ax ;Bytes lesen
  907. ret
  908. Endp
  909.  
  910. GetPhysByte proc pascal
  911. ;holt ein physikalisches Byte aus dem Puffer
  912. push bx ;bx wird vom Aufrufer ben”tigt
  913. cmp w restbyte,0 ;keine Daten mehr im Puffer ?
  914. ja @restda
  915. pusha ;dann Puffer neu fllen
  916. call fillpuf
  917. popa
  918. mov w pufind,0 ;und Zeiger zurck
  919. @restda: ;Daten im Puffer
  920. mov bx,w PufInd ;Puffer-Zeiger laden
  921. mov al,b Puf[bx] ;Byte holen
  922. inc w pufind ;Zeiger weiter
  923. pop bx ;und fertig
  924. ret
  925. Endp
  926.  
  927. GetLogByte proc pascal
  928. ;holt ein logisches Byte aus dem Puffer, benutzt GetPhysByte
  929. push si ;si wird vom Aufrufer ben”tigt
  930. mov ax,w breite ;Byte-Breite holen
  931. mov si,ax ;und sichern
  932. mov dx,w restbits ;lbyte um 8-Restbits nach rechts schieben
  933. mov cx,8
  934. sub cx,dx ;dazu Differenz bilden
  935. mov ax,w lByte
  936. shr ax,cl ;und shiften
  937. mov w akt_code,ax ;Code sichern
  938. sub si,dx ;Restbits bereits geholt -> abziehen
  939. @nextbyte:
  940. call getphysbyte ;neues Byte holen
  941. xor ah,ah
  942. mov w lByte,ax ;in lByte fr n„chstes logische Byte sichern
  943. dec w restbyte ;Byte als geholt markieren
  944.  
  945. mov bx,1 ;restliche Bits in geholtem Byte maskieren
  946. mov cx,si ;dazu Anzahl Bits setzen
  947. shl bx,cl ;1 um Anzahl shiften
  948. dec bx ;und dekrementieren
  949. and ax,bx ;Byte maskieren
  950.  
  951. mov cx,dx ;auf die richtige Position shiften
  952. shl ax,cl ;also um Restbits nach links
  953. add w akt_code,ax ;und zum Ergebnis addieren
  954.  
  955. sbb dx,w breite ;Restbits vermindern
  956. add dx,8 ;um das, was ber 8 Bit hinausgeht
  957. jns @positiv
  958. add dx,8
  959. @positiv:
  960. sub si,8 ;bis zu 8 Bit geholt -> abziehen
  961. jle @fertig ;<= 0 -> alles fertig, Ende
  962. add dx,w breite ;ansonsten Restbits um fehlende Bits erh”hen
  963. sub dx,8
  964. jmp @nextbyte ;und weitermachen
  965. @fertig:
  966. mov w restbits,dx ;Restbits fr n„chsten Aufruf sichern
  967. mov ax,w akt_code ;und ax laden
  968. pop si
  969. ret
  970. Endp
  971.  
  972. ReadGif proc pascal
  973. ;L„dt ein Gif-Bild namens gifname in vscreen, šberlauf wird auf Bildschirm
  974. ;ausgelagert
  975. push ds ;ds sichern
  976. call GifOpen ;Datei ”ffnen
  977. jnc ok ;Fehler ?
  978. mov errornr,1 ;dann melden und beenden
  979. pop ds
  980. ret
  981.  
  982. ok:
  983. call gifseek pascal, 0,13d ;ersten 13 Byte berspringen
  984. push 768d ;768 Byte der Palette laden
  985. call gifread
  986. call shiftpal ;und nach "Palette" konvertieren
  987. call gifread pascal,1 ;ein Byte berspringen
  988.  
  989. @extloop: ;Extension-Blocks berlesen
  990. cmp w puf[0],21h ;noch ein Extension-Block vorhanden ?
  991. jne @noext ;nein, dann weiter
  992. call gifread pascal,2 ;ersten beiden Bytes lesen
  993. mov al,b puf[1] ;L„nge des Datenblocks
  994. inc al ;um eins erh”hen
  995. xor ah,ah
  996. call gifread pascal, ax ;und berlesen
  997. jmp @extloop
  998.  
  999. @noext:
  1000. call gifread pascal, 10d ;Rest des IDBs lesen
  1001. test b puf[8],128 ;lokale Palette ?
  1002. je @nolok ;nein, dann weiter
  1003. push 768 ;ansonsten lesen
  1004. call gifread
  1005. call shiftpal ;und setzen
  1006.  
  1007. @nolok:
  1008. les di,dword ptr vscreen ;Zieladresse laden
  1009.  
  1010. mov w lbyte,0 ;Letztes gelesenes Byte 0
  1011. mov w free,258 ;erster freier Eintrag 258
  1012. mov w breite,9 ;Byte-Breite 9 Bit
  1013. mov w max,511 ;damit maximaler Eintrag bei 511
  1014. mov w stackp,0 ;Stack-Zeiger auf Beginn
  1015. mov w restbits,0 ;keine Restbits
  1016. mov w restbyte,0 ;oder Restbytes zu holen
  1017. @mainloop: ;fr jedes logische Byte durchlaufen
  1018. call getlogByte ;logisches Byte holen
  1019. cmp ax,eof ;End of File - Kennung
  1020. jne @no_abbruch
  1021. jmp @abbruch ;ja, dann Ende
  1022. @no_abbruch:
  1023. cmp ax,clr ;Clr-Code ?
  1024. jne @no_clear
  1025. jmp @clear ;ja, dann Alphabet l”schen
  1026. @no_clear:
  1027. mov w readbyt,ax ;aktuelles Byte sichern
  1028. cmp ax,w free ;ist Code bereits im Alphabet (<free)
  1029. jb @code_in_ab ;ja, dann ausgeben
  1030. mov ax,w old_code ;nein, dann Sonderfall, also letzen String
  1031. mov w akt_code,ax ;zur Bearbeitung geben
  1032. mov bx,w stackp
  1033. mov cx,w sonderfall ;und erstes Zeichen anh„ngen (immer konkret)
  1034. mov w abstack[bx],cx ;dieses auf Stack eintragen
  1035. inc w stackp ;Stack-Pointer weiter
  1036. @code_in_ab: ;Code im Alphabet vorhanden:
  1037. cmp ax,clr ;< Clr-Code ?
  1038. jb @konkret ;dann konkretes Zeichen
  1039. @fillstack_loop: ;ansonsten entschlsseln
  1040. mov bx,w akt_code ;dazu aktuellen Code als Zeiger im Alphabet
  1041. shl bx,1 ;Word-Array (!)
  1042. push bx
  1043. mov ax,w ab_tail[bx] ;Tail holen, der ist konkret
  1044. mov bx,w stackp ;also auf Stack schieben
  1045. shl bx,1 ;ebenfalls Word-Array
  1046. mov w abstack[bx],ax ;eintragen
  1047. inc w stackp
  1048. pop bx
  1049. mov ax,w ab_prfx[bx] ;Prefix holen
  1050. mov w akt_code,ax ;als aktuellen Code zum Entschlsseln geben
  1051. cmp ax,clr ;> Clr-Code
  1052. ja @fillstack_loop ;dann weiter entschlsseln
  1053. @konkret: ;jetzt nur noch konkrete Werte auf dem Stack
  1054. mov bx,w stackp ;letzten Code auf den Stack schieben
  1055. shl bx,1 ;Word-Array
  1056. mov w abstack[bx],ax
  1057. mov w sonderfall,ax ;auch fr den Sonderfall vermerken
  1058. inc w stackp ;Zeiger weiter
  1059. mov bx,w stackp ;Lesen des Stack vorbereiten
  1060. dec bx ;Zeiger vermindern und
  1061. shl bx,1 ;auf Word-Array ausrichten
  1062. @readstack_loop: ;Stack abarbeiten
  1063. mov ax,w abstack[bx] ;Zeichen vom Stack holen
  1064. stosb ;und in Ziel-Speicher schreiben
  1065.  
  1066. cmp di,0 ;Segment-šberlauf ?
  1067. jne @noovl1
  1068. call p13_2_modex pascal,vram_pos,16384d
  1069. add vram_pos,16384d ;dann Teil in Bildschirmspeicher auslagern
  1070. les di,dword ptr vscreen ;Position im VGA-Ram weiter und Zielzeiger neu
  1071.  
  1072. @noovl1:
  1073. dec bx ;Stack-Pointer auf n„chstes Element
  1074. dec bx
  1075. jns @readstack_loop ;abgearbeitet ? nein, dann weiter
  1076. mov w stackp,0 ;Stackpointer-Variable auf 0
  1077. mov bx,w free ;jetzt in Alphabet eintragen
  1078. shl bx,1 ;dazu auf Position "free" positionieren
  1079. mov ax,w old_code ;letzten Code in Pr„fix schreiben
  1080. mov w ab_prfx[bx],ax
  1081. mov ax,w akt_code ;aktuellen Code in Tail
  1082. mov w ab_tail[bx],ax
  1083. mov ax,w readbyt ;gelesenes Byte als letzten Code sichern
  1084. mov w old_code,ax
  1085. inc w free ;auf n„chste Position innerhalb d. Alphabets
  1086. mov ax,w free
  1087. cmp ax,w max ;bereits Maximum erreicht ?
  1088. ja @no_mainloop
  1089. jmp @mainloop ;nein, dann einfach weitermachen
  1090. @no_mainloop:
  1091. cmp b breite,12 ;Breite bereits 12 Bit ?
  1092. jb @no_mainloop2
  1093. jmp @mainloop ;ja, dann einfach weitermachen
  1094. @no_mainloop2:
  1095. inc w breite ;sonst erh”hen
  1096. mov cl,b breite ;neuen Maximalwert berechnen
  1097. mov ax,1 ;1 um neue Breite nach links schieben
  1098. shl ax,cl
  1099. dec ax ;und dekrementieren
  1100. mov w max,ax ;eintragen
  1101. jmp @mainloop ;und zurck zur Hauptschleife
  1102. @clear: ;Alphabet zurcksetzen:
  1103. mov w breite,9 ;Breite wieder auf Ursprungswert
  1104. mov w max,511 ;Maximum wieder bei 511
  1105. mov w free,258 ;erste freie Position bei 258
  1106. call getlogbyte ;n„chstes Byte holen
  1107. mov w sonderfall,ax ;als Sonderfall vermerken
  1108. mov w old_code,ax ;und auch als zuletzt gelesenen
  1109. stosb ;diesen Wert direkt in Speicher, weil konkret
  1110.  
  1111. cmp di,0 ;Segment-šberlauf ?
  1112. jne @noovl2
  1113. call p13_2_modex pascal,vram_pos,16384d
  1114. add vram_pos,16384d ;dann in Bildschirmspeicher auslagern
  1115. les di,dword ptr vscreen ;VGA-Ram Zeiger weiter und Startadresse neu
  1116.  
  1117. @noovl2:
  1118. jmp @mainloop ;zurck zur Hauptschleife
  1119. @abbruch: ;Abbruch durch Eof-Code
  1120. call gifclose ;Datei schlieáen
  1121. mov rest,di ;Anzahl noch zu kopierender Bytes sichern
  1122. pop ds ;und beenden
  1123. ret
  1124. Endp
  1125.  
  1126. code ends
  1127. end
  1128.  
  1129. .286
  1130. w equ word ptr
  1131. b equ byte ptr
  1132. data segment public
  1133. extrn vscreen:dword
  1134. extrn vpage:word
  1135. extrn palette:dataptr
  1136. data ends
  1137.  
  1138.  
  1139. code segment public
  1140. assume cs:code,ds:data
  1141. public init_modex, p13_2_modex, squeeze, copyscreen, double
  1142. public clrx, split, setpal, getpal, switch, setstart, enter400
  1143. public waitretrace, fade_out, fade_to, copy_block, pal_rot
  1144.  
  1145. switch proc far ;schaltet zw. beiden Bildschirmseiten um
  1146. mov bx,vpage ;Startadresse laden
  1147. mov dx,3d4h
  1148. mov al,0ch ;auf CRTC-Register 0dh/0ch aufteilen
  1149. mov ah,bh
  1150. out dx,ax ;Highbyte setzen (Register 0dh)
  1151. inc al
  1152. mov ah,bl
  1153. out dx,ax ;Lowbyte setzen (Register 0ch)
  1154. cmp bx,16000d ;Startadresse umschalten (0/16000)
  1155. je setze0
  1156. mov vpage,16000
  1157. ret
  1158. setze0:
  1159. mov vpage,0
  1160. ret
  1161. switch endp
  1162.  
  1163. Init_ModeX proc pascal far ;schaltet Mode X ein
  1164. mov ax,0013h ;Mode 13h setzen
  1165. int 10h
  1166.  
  1167. mov dx,3c4h ;Timing Sequenzer
  1168. mov al,4 ;Register 4 (Memory Mode):
  1169. out dx,al ;Bit 3 l”schen -> Chain4 aus
  1170. inc dx
  1171. in al,dx
  1172. and al,0f7h
  1173. or al,4h ;Bit 2 setzen -> Odd/Even Mode aus
  1174. out dx,al
  1175. dec dx
  1176.  
  1177. mov ax,0f02h ;Register 2 (Write Plane Mask):
  1178. out dx,ax ;0fh: alle Planes beim Schreiben ein
  1179. mov ax,0a000h ;Bildschirmspeicher l”schen
  1180. mov es,ax
  1181. xor di,di
  1182. xor ax,ax
  1183. mov cx,0ffffh
  1184. cld
  1185. rep stosw
  1186.  
  1187. mov dx,3d4h ;CRTC
  1188. mov al,14h ;Register 14h (Underline Row Adress):
  1189. out dx,al
  1190. inc dx
  1191. in al,dx ;Bit 6 l”schen -> Doubleword adress. aus
  1192. and al,0bfh
  1193. out dx,al
  1194. dec dx
  1195. mov al,17h ;Register 17h (CRTC Mode):
  1196. out dx,al ;Bit 6 setzen -> Byte Mode ein
  1197. inc dx
  1198. in al,dx
  1199. or al,40h
  1200. out dx,al
  1201. ret
  1202. Endp
  1203.  
  1204. Enter400 proc pascal far ;schaltet von Mode X (200 Zeilen)
  1205. mov dx,3d4h ;in erweieterten 400-Zeilen-Modus
  1206. mov al,9 ;CRTC Register 9 (Maximum Row Adress)
  1207. out dx,al ;selektieren
  1208. inc dx ;Wert auslesen
  1209. in al,dx
  1210. and al,01110000b ;Bit 7 und 3:0 l”schen
  1211. out dx,al ;und zurckschreiben
  1212. ret
  1213. Enter400 endp
  1214.  
  1215. plane_l: db 0
  1216. plane_pos: dw 0
  1217.  
  1218. p13_2_modex proc pascal far start,pic_size:word
  1219. mov dx,03ceh ;Write Mode 0 setzen
  1220. mov ax,4005h ;ber GDC Register 5 (GDC Mode)
  1221. out dx,ax
  1222.  
  1223. mov b plane_l,1 ;Plane-Maske speichern
  1224. push ds
  1225. lds si,dword ptr ds:vscreen ;Quelladresse laden
  1226. mov w plane_pos,si ;und sichern
  1227. mov ax,0a000h ;Zieladresse setzen
  1228. mov es,ax
  1229. mov di,start
  1230. mov cx,pic_size ;Anzahl holen
  1231. @lpplane:
  1232. mov al,02h ;TS Register 2 (Write Plane Mask)
  1233. mov ah,b plane_l ;entsprechende Plane maskieren
  1234. mov dx,3c4h
  1235. out dx,ax
  1236.  
  1237. @lp1:
  1238. movsb ;Byte kopieren
  1239. add si,3 ;auf n„chstes Quellbyte positionieren
  1240. loop @lp1
  1241.  
  1242. mov di,start ;Zieladresse neu holen
  1243. inc w plane_pos ;Quelladresse auf neuen Start
  1244. mov si,w plane_pos
  1245. mov cx,pic_size ;GrӇe holen
  1246. shl b plane_l,1 ;n„chste Plane maskieren
  1247. cmp b plane_l,10h ;alle 4 Planes kopiert ?
  1248. jne @lpplane
  1249.  
  1250. pop ds
  1251. ret
  1252. Endp
  1253. Split proc pascal far row:byte ;Screen-Splitting in Zeile row
  1254. mov bl,row
  1255. xor bh,bh
  1256. shl bx,1 ;*2 wg. Zeilenverdopplung
  1257. mov cx,bx
  1258.  
  1259. mov dx,3d4h ;CRTC
  1260. mov al,07h ;Register 7 (Overflow low)
  1261. out dx,al
  1262. inc dx
  1263. in al,dx
  1264. and al,11101111b ;Bit 4 mit Bit 8 der Zeile laden
  1265. shr cx,4
  1266. and cl,16
  1267. or al,cl
  1268. out dx,al ;und setzen
  1269.  
  1270. dec dx
  1271. mov al,09h ;Register 9 (Maximum Row Adress)
  1272. out dx,al
  1273. inc dx
  1274. in al,dx
  1275. and al,10111111b ;Bit 6 mit Bit 9 der Zeile laden
  1276. shr bl,3
  1277. and bl,64
  1278. or al,bl
  1279. out dx,al ;und setzen
  1280.  
  1281. dec dx
  1282. mov al,18h ;Register 18h (Line Compare/Split Screen)
  1283. mov ah,row ;restlichen 8 Bit setzen
  1284. shl ah,1
  1285. out dx,ax
  1286. ret
  1287. Endp
  1288. SetStart proc pascal far t:word ;setzt Bildschirmstart auf angegebene Adr.
  1289. mov dx,3d4h ;CRTC
  1290. mov al,0ch ;Register 0ch(Linear Starting Adress Middle)
  1291. mov ah,byte ptr t + 1 ;Bits 15:8 setzen
  1292. out dx,ax ;Register 0dh(LSA Low)
  1293. mov al,0dh ;Bits 7:0 setzen
  1294. mov ah,byte ptr t
  1295. out dx,ax
  1296. ret
  1297. Endp
  1298. WaitRetrace proc pascal far
  1299. mov dx,3dah ;Input Status Register 1
  1300. @wait1:
  1301. in al,dx ;Bit 3 wird 0 wenn Strahl beim Bildaufbau
  1302. test al,08h
  1303. jnz @wait1
  1304. @wait2:
  1305. in al,dx ;Bit 3 wird 1 wenn Retrace
  1306. test al,08h
  1307. jz @wait2
  1308. ret ;jetzt ist Strahl ganz unten am Bildschirm
  1309. Endp
  1310. public squeeze
  1311. squeeze proc pascal far ;f„hrt Bildschirm zusammen
  1312. mov si,200*80 ;Start-Wert fr Startadresse
  1313. mov di,199 ;Start-Wert fr Split-Zeile
  1314. sqlp: ;Hauptschleife
  1315. call waitretrace ;auf Retrace warten
  1316. call split pascal, di ;Setzen der unteren H„lfte durch Splitting
  1317. call setstart pascal, si ;Setzen der oberen H„lfte durch Scrolling
  1318. sub si,80 ;eine Zeile weiter, also nach unten fahren
  1319. dec di ;Split eine Zeile runter, also untere
  1320. cmp di,99d ;H„lfte rauffahren
  1321. jae sqlp ;fertig ?
  1322. ret
  1323. squeeze endp
  1324. clrx proc pascal far pmask:byte ;L”scht Mode X - Seiten
  1325. mov al,02h
  1326. mov ah,pmask
  1327. mov dx,3c4h
  1328. out dx,ax
  1329. mov ax,0a000h ;Startadresse und L„nge holen
  1330. mov es,ax
  1331. mov di,vpage
  1332. xor ax,ax
  1333. mov cx,8000
  1334. rep stosw ;und l”schen
  1335. ret
  1336. clrx endp
  1337. copyscreen proc pascal far ziel,quelle:word
  1338. mov dx,3c4h ;alle Planes selektieren
  1339. mov ax,0f02h
  1340. out dx,ax
  1341. mov dx,3ceh ;Write-Mode 1 (kopieren)
  1342. mov ax,4105h
  1343. out dx,ax
  1344.  
  1345. push ds
  1346. mov ax,0a000h ;Quell- und Zielsegment im VGA
  1347. mov es,ax
  1348. mov ds,ax
  1349. mov si,quelle ;Quell- und Zieloffset laden
  1350. mov di,ziel
  1351. mov cx,16000d ;16000 Byte (=64000 Pixel) kopieren
  1352. rep movsb
  1353. pop ds
  1354. mov dx,3ceh ;Write-Mode 0
  1355. mov ax,4005h
  1356. out dx,ax
  1357. ret
  1358. copyscreen endp
  1359. SetPal proc pascal far
  1360. push si
  1361. mov si,offset palette ;Adresse holen
  1362. mov cx,256*3 ;Anzahl Farben holen
  1363. xor al,al
  1364. mov dx,03c8h ;External Palette RAM, Pixel Write Adress
  1365. out dx,al ;ab Farbe 0 setzen
  1366. inc dx ;Pixel Color Value
  1367.  
  1368. rep outsb ;alle Farben an VGA schicken
  1369. pop si
  1370. ret
  1371. Endp
  1372.  
  1373. getpal proc pascal far
  1374. push di
  1375. mov di,offset palette ;Adresse holen
  1376. mov cx,256*3 ;Anzahl Farben holen
  1377. xor al,al
  1378. mov dx,03c7h ;External Palette RAM, Pixel Read Adress
  1379. out dx,al ;ab Farbe 0 lesen
  1380. mov dx,3c9h ;Pixel Color Value
  1381.  
  1382. rep insb ;alle Farben an VGA schicken
  1383. pop di
  1384. ret
  1385. Endp
  1386.  
  1387. double proc pascal far
  1388. mov dx,3d4h ;CRTC Register 13h (Row Offset)
  1389. mov ax,5013h ;auf 80 setzen (doppelte Breite)
  1390. out dx,ax ;und schreiben
  1391. ret
  1392. double endp
  1393.  
  1394.  
  1395. fade_out proc pascal far ;Fadet Bild raus, Video-Modus unabh„ngig
  1396. local groesste:word ;beinhaltet maximal m”glichen Farb-Wert
  1397. mov groesste,63
  1398. mov ax,ds ;Ziel-Segment laden
  1399. mov es,ax
  1400. main_loop: ;Hauptschleife, wird einmal pro Bild durchl.
  1401. lea si,palette ;Quell- und Zieloffset auf Palette
  1402. mov di,si
  1403. mov cx,768 ;768 Byte modifizieren
  1404. lp:
  1405. lodsb ;Wert holen
  1406. dec al ;herunterz„hlen
  1407. jns setzen ;wenn noch nicht negativ -> setzen
  1408. xor al,al ;sonst 0
  1409. setzen:
  1410. stosb ;Zielwert in "Palette" schreiben
  1411.  
  1412. dec cx ;Schleifenz„hler
  1413. jne lp
  1414.  
  1415. call waitretrace ;auf Retrace synchronisieren
  1416. call setpal ;berechnete Palette setzen
  1417. dec groesste ;„uáere Schleife herunter z„hlen
  1418. jne main_loop ;noch nicht fertig ? dann weiter
  1419.  
  1420. ret
  1421. fade_out endp
  1422.  
  1423.  
  1424. fade_to proc pascal far zielpal:dword, laenge:word, schritt:byte
  1425. ;fadet "Palette" auf "Zielpal", šbergabe von Pascal als Array of Byte !
  1426. local groesste:word
  1427. mov ax,63 ;Anzahl Durchl„ufe berechnen, die
  1428. div schritt ;n”tig sind, um 63 zu erreichen
  1429. xor ah,ah
  1430. mov groesste,ax ;Anzahl Schleifendurchl„ufe setzen
  1431. next_frame:
  1432. les di,zielpal ;Offset holen, Pascal bergibt Arrays far !
  1433. lea si,palette ;Offset der "Palette" holen
  1434. mov cx,768 ;768 Bytes bearbeiten
  1435.  
  1436. weiter:
  1437. mov al,[si] ;Wert aus aktueller Palette holen
  1438. mov ah,[di] ;Wert aus Zielpal holen
  1439.  
  1440. mov bl,ah
  1441. sub bl,al ;Differenz zum Zielwert
  1442. cmp bl,schritt ;mehr als ein Schritt drber ?
  1443. jg rauf ;-> runterz„hlen
  1444. neg bl ;Differenz
  1445. cmp bl,schritt ;grӇer als negativer Schritt
  1446. jg runter
  1447.  
  1448. mov al,ah ;Ziel erreicht, endgltig setzen
  1449.  
  1450. schreiben:
  1451. dec cx ;Farb-Schleife runter
  1452. je fertig ;0 ? -> fertig
  1453. mov [si],al ;Wert in Palette schreiben
  1454. inc si ;n„chsten Wert selektieren
  1455. inc di
  1456. jmp weiter ;und weitermachen
  1457. runter:
  1458. sub al,schritt ;herunterz„hlen
  1459. jmp schreiben
  1460. rauf:
  1461. add al,schritt ;heraufz„hlen
  1462. jmp schreiben
  1463. fertig: ;Palette fertig berechnet
  1464. call waitretrace ;Synchronisation
  1465. call setpal ;Palette setzen
  1466. dec groesste ;alle 63 Durchl„ufe fertig ?
  1467. jne next_frame ;nein -> weiter
  1468.  
  1469. ret
  1470. fade_to endp
  1471.  
  1472. copy_block proc pascal far ziel,quelle,breite,hoehe:word
  1473. local sprung:word
  1474. mov dx,3ceh ;GDC
  1475. mov ax,4105h ;ReadMode 0, WriteMode 1
  1476. out dx,ax ;auf Register 5 : GDC Mode
  1477. mov dx,3c4h ;TS
  1478. mov ax,0f02h ;alle Planes einschalten
  1479. out dx,ax ;auf Register 2 : Write Plane Mask
  1480.  
  1481. push ds
  1482. mov ax,0a000h ;Kopieren innerhalb VGA
  1483. mov es,ax ;-> beide Segmente auf 0a000h
  1484. mov ds,ax
  1485. mov si,quelle ;Quelldaten von Quelle
  1486. mov di,ziel ;nach Ziel kopieren
  1487. mov dx,hoehe ;hoehe Zeilen kopieren
  1488.  
  1489. mov ax,80 ;Sprung zwischen zwei Zeilen berechnen
  1490. sub ax,breite ;(= 80-Breite)
  1491. mov sprung,ax
  1492.  
  1493. line_lp:
  1494. mov cx,breite ;Breite laden
  1495. rep movsb ;eine Zeile kopieren
  1496. add si,sprung
  1497. add di,sprung
  1498.  
  1499. dec dx ;Zeilenz„hler weiter
  1500. jne line_lp
  1501.  
  1502. pop ds
  1503. ret
  1504. copy_block endp
  1505.  
  1506. Pal_Rot proc pascal far Start,Ende:Word
  1507. ;rotiert Palettenteil Start bis Ende um 1
  1508. ;wenn Start < Ende : Rotation nach unten
  1509. ;wenn Start > Ende : Rotation nach oben
  1510.  
  1511. mov ax,ds ;es auf Datensegment
  1512. mov es,ax
  1513.  
  1514. lea si,palette ;Palettenoffset laden
  1515. mov di,si ;auch nach di
  1516.  
  1517. mov ax,3 ;"Start" in Palettenoffset umrechnen
  1518. mul start
  1519. add si,ax ;und auf si addieren
  1520. mov ax,3 ;das Gleiche fr Ziel
  1521. mul ende
  1522. add di,ax ;auf di addieren
  1523.  
  1524. mov bx,[si] ;Bytes der Start-Farbe sichern
  1525. mov dl,[si+2]
  1526.  
  1527. mov cx,di ;Differenz zw. Start und Ende ist Anzahl
  1528. sub cx,si ;zu kopierender Bytes
  1529.  
  1530. mov di,si ;Start-Farbe als Ziel-Offset
  1531. add si,3 ;eine Farbe darber als Quell-Offset
  1532. ;fr vorw„rts kopieren bereits fertig
  1533. cld ;Vorgabe: vorw„rts kopieren
  1534. or cx,cx ;wenn cx negativ (Start > Ende)
  1535. jns vorwaerts
  1536. std ;dann rckw„rts kopieren
  1537. neg cx ;cx korrigieren
  1538. sub si,4 ;si auf das 2. Byte der vorletzten Farbe
  1539. add di,2 ;di auf das 2. Byte der letzten Farbe
  1540. add cx,2 ;2 Byte mehr kopieren,
  1541. vorwaerts: ;damit Position nach Kopierschleife stimmt
  1542.  
  1543. rep movsb ;Farben kopieren
  1544. mov [di],bx ;Bytes der alten Start-Farbe
  1545. mov [di+2],dl ;als letzte Farbe schreiben
  1546.  
  1547. cld ;Direction-Flag wieder l”schen
  1548. ret
  1549. Pal_Rot Endp
  1550.  
  1551. code ends
  1552. end
  1553. .286
  1554. w equ word ptr
  1555. b equ byte ptr
  1556.  
  1557. include texture.inc ;Textur-Makros implementieren
  1558.  
  1559. setnewlinel macro ;Hier nur ax und bx verwenden !
  1560. local dylpos,dxlpos,dxlgross,macro_fertig
  1561. mov bx,4043h ;Code fr inc ax (in bh) und inc bx (in bl)
  1562. mov bp,links
  1563. mov ax,poly2d[bp+8] ;Zielkoordinaten sichern
  1564. mov xl1,ax
  1565. mov ax,poly2d[bp+10d]
  1566. mov yl1,ax
  1567.  
  1568. mov ax,poly2d[bp] ;links x/y Start in glob. var
  1569. mov xl0,ax
  1570. sub ax,xl1 ;delta x bilden
  1571. inc xl1 ;fr die Abbruchbedingung
  1572. neg ax ;xl1-xl0
  1573. jns dxlpos ;dxl negativ ?
  1574. neg ax ;dann Betrag bilden
  1575. mov bh,48h ;Code fr dec ax (dec xl0)
  1576. sub xl1,2 ;Erweiterung der Zielkoordinate nach negativ
  1577. dxlpos:
  1578. mov dxl,ax ;und glob. sichern
  1579. mov incflagl,ax ;im Inkrement-Flag sichern
  1580. mov ax,poly2d[bp+2]
  1581. mov yl0,ax
  1582. sub ax,yl1 ;|delta y| bilden
  1583. inc yl1 ;fr die Abbruchbedingung
  1584. neg ax
  1585. jns dylpos ;negativ ?
  1586. neg ax ;dann Betrag bilden
  1587. mov bl,4bh ;Code fr dec bx (dec yl1)
  1588. sub yl1,2 ;Erweiterung der Zielkoordinate nach negativ
  1589. dylpos:
  1590. mov dyl,ax ;und glob. sichern
  1591. cmp dxl,ax ;dx < dy
  1592. jae dxlgross
  1593. neg incflagl ;dann Vorzeichenwechsel fr Inkrement-Flag
  1594. dxlgross:
  1595. mov cs:byte ptr incxl,bh ;Selbstmodifikation durchfhren
  1596. mov cs:byte ptr incyl,bl
  1597.  
  1598. cmp texture,1 ;Texturen ben”tigt ?
  1599. jne macro_fertig ;nein, dann berspringen
  1600.  
  1601. txt_makevarl ;sonst Textur-Variablen berechnen
  1602.  
  1603. macro_fertig:
  1604. mov ax,xl0 ;Register als Laufvariablen verwenden
  1605. mov bx,yl0
  1606. mov si,incflagl
  1607. endm
  1608.  
  1609. setnewliner macro ;Hier nur cx und dx verwenden !
  1610. local dyrpos,dxrpos,dxrgross,macro_fertig
  1611. mov cx,4142h ;Code fr inc cx (in ch) und inc dx (in cl)
  1612. mov bp,rechts
  1613. mov dx,poly2d[bp] ;Zielkoordinaten holen
  1614. mov xr1,dx
  1615. mov dx,poly2d[bp+2]
  1616. mov yr1,dx
  1617. mov dx,poly2d[bp+8] ;rechts x/y in glob. var
  1618. mov xr0,dx
  1619. sub dx,xr1 ;|delta x| bilden
  1620. inc xr1 ;fr die Abbruchbedingung
  1621. neg dx
  1622. jns dxrpos ;negativ ?
  1623. neg dx ;dann Betrag bilden
  1624. mov ch,49h ;Code fr dec cx
  1625. sub xr1,2 ;Erweiterung der Zielkoordinate nach negativ
  1626. dxrpos:
  1627. mov dxr,dx ;in glob. Var sichern
  1628. mov incflagr,dx
  1629. mov dx,poly2d[bp+10d] ;|delta y| bilden
  1630. mov yr0,dx
  1631. sub dx,yr1
  1632. inc yr1 ;fr die Abbruchbedingung
  1633. neg dx
  1634. jns dyrpos ;negativ ?
  1635. neg dx ;dann Betrag bilden
  1636. mov cl,4ah ;Code fr dec dx
  1637. sub yr1,2 ;Erweiterung der Zielkoordinate nach negativ
  1638. dyrpos:
  1639. mov dyr,dx ;und in glob. var sichern
  1640. cmp dxr,dx ;dx < dy ?
  1641. jae dxrgross
  1642. neg incflagr ;dann Vorzeichenwechsel fr Inkrement-Flag
  1643. dxrgross:
  1644. mov cs:byte ptr incxr,ch ;Selbstmodifikation
  1645. mov cs:byte ptr incyr,cl
  1646.  
  1647. cmp texture,1 ;Texturen ben”tigt ?
  1648. jne macro_fertig ;nein, dann berspringen
  1649.  
  1650. txt_makevarr ;sonst Textur-Variablen berechnen
  1651.  
  1652. macro_fertig:
  1653. mov cx,xr0 ;Register laden
  1654. mov dx,yr0
  1655. mov di,incflagr
  1656. endm
  1657.  
  1658. data segment public
  1659. extrn vpage:word ;aktuelle Bildschirmseite
  1660. extrn fl_ruecken ;Flag fr Fl„chenrckenunterdrckung
  1661. extrn glas:Byte; ;Flag fr Glas-Fl„chen
  1662.  
  1663. ;Textur-Variablen:
  1664. extrn Texture:Byte ;Textur ben”tigt ?
  1665. extrn Txt_Daten:DataPtr ;Array mit Zeigern auf Grafikdaten
  1666. extrn Txt_Offs:DataPtr ;Array mit Offsets innerhalb des Textur-Bilds
  1667. extrn Txt_Groesse:DataPtr ;Array mit GrӇenangaben
  1668.  
  1669. d_x dd 0 ;relative x-Koordinate
  1670. d_y dd 0 ;relative y-Koordinate
  1671. D dd 0 ;Hauptdeterminante
  1672. Spalte1 dd 0 ;Komponenten der Hauptdeterminante
  1673. dd 0
  1674. Spalte2 dd 0
  1675. dd 0
  1676. obere_Reihe dw 0 ;welche Koordinaten wurden benutzt ?
  1677. untere_Reihe dw 0
  1678.  
  1679. xl_3d dd 0 ;Laufwerte fr 3d-Koordinaten beim Fllen
  1680. yl_3d dd 0
  1681. zl_3d dd 0
  1682. xr_3d dd 0
  1683. yr_3d dd 0
  1684. zr_3d dd 0
  1685.  
  1686. inc_xl dd 0 ;Werte fr Addition auf Laufwerte
  1687. inc_yl dd 0
  1688. inc_zl dd 0
  1689. inc_xr dd 0
  1690. inc_yr dd 0
  1691. inc_zr dd 0
  1692.  
  1693. ;Variablen fr Fllalghorithmus
  1694. hoch_punkt dw 0 ;w„hrend Suche in dx gehalten
  1695. hoch_y dw 0 ;w„hrend Suche in bx gehalten
  1696.  
  1697. links dw 0 ;Punkt der linken Seite
  1698. rechts dw 0 ;Punkt der rechten Seite
  1699.  
  1700. xl0 dw 0 ;Laufwerte fr linke Start- und Endpunkte
  1701. yl0 dw 0
  1702. xl1 dw 0
  1703. yl1 dw 0
  1704. xr0 dw 0 ;Laufwerte fr rechts
  1705. yr0 dw 0
  1706. xr1 dw 0
  1707. yr1 dw 0
  1708. dxl dw 0 ;Delta X / Y fr beide Seiten
  1709. dyl dw 0
  1710. dxr dw 0
  1711. dyr dw 0
  1712. incflagl dw 0 ;Flags, wann y inkrementiert werden muá
  1713. incflagr dw 0 ;also eine Art "Steigung"
  1714.  
  1715. data ends
  1716.  
  1717. code segment public
  1718. assume cs:code,ds:data
  1719. extrn polycol:word ;Fl„chenfarbe
  1720. extrn polyn:word ;Anzahl Ecken
  1721. extrn poly2d:word ;Array mit 2D-Koordinaten
  1722. extrn poly3d:word ;Array mit 3D-Koordinaten
  1723. extrn delta1,delta2:word ;Ebenenvektoren
  1724. extrn bline:near ;zeichnet Linie
  1725.  
  1726. lambda1 dd 0 ;affine Koordinaten
  1727. lambda2 dd 0
  1728.  
  1729. inc_lambda1 dd 0 ;Schrittweiten
  1730. inc_lambda2 dd 0
  1731.  
  1732. plane dw 0002h ;aktuell zu setzende Plane
  1733. x0 dw 0 ;Koordinaten fr Linie
  1734. y0 dw 0
  1735. x1 dw 0
  1736. zz dw 0 ;noch zu zeichnende Punkte
  1737.  
  1738. extrn Txt_Nr:Word ;Nummer der zu zeichnenden Textur
  1739.  
  1740. public drawpol
  1741. ;zeichnet Drahtmodell der Fl„che in Poly2d
  1742. drawpol proc near
  1743. push es
  1744. pusha
  1745. xor si,si ;Index auf ersten Eintrag
  1746. mov bp,polyn ;Anzahl Ecken holen
  1747. @nline:
  1748. mov ax,poly2d[si] ;Koordinaten aus Tabelle holen
  1749. mov bx,poly2d[si+2]
  1750. mov cx,poly2d[si+8]
  1751. mov dx,poly2d[si+10d]
  1752. push bp
  1753. push si
  1754. call bline ;Linie zeichnen
  1755. pop si
  1756. pop bp
  1757. add si,8 ;n„chste Linie
  1758. dec bp ;Anzahl dekrementieren
  1759. jne @nline
  1760. popa
  1761. pop es
  1762. ret
  1763. drawpol endp
  1764.  
  1765. hline proc near ;zeichnet horiz. Linie ax/bx -> cx/bx
  1766. pusha
  1767. push es
  1768. mov x0,ax ;Koordinaten fr sp„ter sichern
  1769. mov y0,bx
  1770. mov x1,cx
  1771. sub cx,ax ;Anzahl zu zeichnender Punkte berechnen
  1772. jne zzok
  1773. inc cx
  1774.  
  1775. zzok:
  1776. mov zz,cx
  1777.  
  1778. cmp glas,1 ;Glas-Fl„chen ?
  1779. jne Solid1
  1780. push ax ;ja, dann GDC-Modus: OR
  1781. mov dx,3ceh
  1782. mov ax,1003h ;Register 3: Function Select
  1783. out dx,ax
  1784. pop ax
  1785.  
  1786. Solid1:
  1787. mov dx,3c4h ;Timing Sequenzer-Port
  1788. mov di,0a000h
  1789. mov es,di ;VGA-Segment w„hlen
  1790. mov di,ax ;Offset berechnen
  1791. shr di,2 ;(x div 4) + y*80
  1792. add di,vpage ;aktuelle Seite drauf
  1793. mov bx,y0
  1794. imul bx,80d
  1795. add di,bx ;jetzt in di
  1796. cmp zz,4
  1797. jl keine_mitte ;<4 Punkte zeichnen -> keine 4er-Bl”cke
  1798. and ax,11b ;untere beiden Bit sind wichtig
  1799. je mitte ;wenn 0 sofort 4er-Bl”cke setzen
  1800. keine_mitte:
  1801. mov bx,0f02h ;wenn kein_shift, dann diese Maske benutzen
  1802. mov cx,zz ;Anzahl Punkte in Maske setzen
  1803. cmp cx,20h ;ab 20h shiftet der 386 wieder rein !
  1804. jae kein_shift
  1805. mov bx,0102h ;Maske vorbereiten
  1806. shl bh,cl ;Anzahl Punkte=Anzahl zu setzender Bits
  1807. dec bh
  1808. and bh,0fh
  1809. kein_shift:
  1810. mov cx,ax ;je nach Startplane richtig schieben
  1811. and cl,3
  1812. shl bh,cl
  1813. mov ax,bx ;und Maske fertig
  1814. sub zz,4 ;zu zeichnende Punkte runterzaehlen
  1815. add zz,cx
  1816. start:
  1817. out dx,ax ;berechnete Schreibmaske setzen
  1818. mov al,b polycol ;Farbe holen
  1819.  
  1820. mov ah,es:[di] ;Latches laden, nur fr Glas-K”rper
  1821.  
  1822. stosb ;setzen
  1823. mitte:
  1824. cmp zz,4
  1825. jl schluss ;wenn kein 4er Block mehr -> Abschluss
  1826.  
  1827. mov ax,0f02h ;alle Planes selektieren
  1828. out dx,ax ;(zz div 4) 4er Bl”cker setzen
  1829. mov cx,zz
  1830. shr cx,2
  1831. mov al,b polycol
  1832.  
  1833. cmp glas,1 ;Glas-K”rper ?
  1834. jne Solid
  1835.  
  1836. @lp:
  1837. mov ah,es:[di] ;Latches laden, nur fr Glas-K”rper
  1838. stosb ;und zurckschreiben
  1839. dec cx
  1840. jne @lp
  1841. jmp schluss
  1842.  
  1843. Solid:
  1844. rep stosb ;Mittelteil zeichnen
  1845.  
  1846. schluss:
  1847. mov cx,x1 ;šbrige Pixel setzen
  1848. and cx,3h
  1849. dec zz
  1850. js hline_fertig ;wenn nichts mehr da -> Ende
  1851. mov ax,0102h
  1852. shl ah,cl ;Maske erstellen
  1853. dec ah
  1854. out dx,ax
  1855. mov al,b polycol ;Farbe holen
  1856.  
  1857. mov ah,es:[di] ;Latches laden, nur fr Glas-K”rper
  1858.  
  1859. stosb ;und Punkte zeichnen
  1860. hline_fertig:
  1861. mov dx,3ceh ;GDC-Mode wieder auf MOVE
  1862. mov ax,0003h
  1863. out dx,ax
  1864. pop es
  1865. popa
  1866. ret
  1867. hline endp
  1868.  
  1869. txt_hline ;Macro enth„lt die Prozedur "hline_texture"
  1870.  
  1871. public fillpol
  1872. fillpol proc near ;fllt Polygon in Mode X
  1873. push bp
  1874. pusha
  1875.  
  1876. cmp texture,1 ;werden Texturen benutzt ?
  1877. jne Fllen ;nein, dann einfach fllen
  1878.  
  1879. txt_Hauptdet ;sonst Hauptdeterminante berechnen
  1880.  
  1881. Fllen:
  1882. xor si,si ;Suche nach h”chstem Punkt,ersten Eintrag sel.
  1883. mov cx,polyn ;Anzahl Ecken
  1884. sub cx,2
  1885. mov bx,0ffffh ;extrem hoher Wert, auf jeden Fall unterboten
  1886. npoint:
  1887. mov ax,poly2d[si+2] ;y holen
  1888. cmp ax,bx ;wenn bisheriges Minimum unterboten
  1889. ja no_min
  1890. mov bx,ax ;neues Minimum festhalten
  1891. mov dx,si
  1892. no_min:
  1893. add si,8
  1894. dec cx ;n„chste Ecke, wenn nicht 0ffffh
  1895. jns npoint
  1896. mov hoch_punkt,dx ;in glob var festhalten
  1897. mov hoch_y,bx ;Hochpunkt-Suche abgeschlossen
  1898.  
  1899. or dx,dx ;links = 0 ?
  1900. jne dec_valid
  1901. mov bx,polyn ;ja: rechts ans andere Ende
  1902. sub bx,2
  1903. shl bx,3
  1904. jmp lr_fertig ;positionieren
  1905. dec_valid:
  1906. mov bx,dx ;ansonsten einen davor
  1907. sub bx,8
  1908. lr_fertig:
  1909. mov links,dx ;in glob var festhalten
  1910. mov rechts,bx
  1911.  
  1912. ; ax/bx : Startkoordinaten links (xl0/yl0)
  1913. ; cx/dx : Startkoordinaten rechts (xr0/yr0)
  1914. ; si : šberlaufflag links
  1915. ; di : šberlaufflag rechts
  1916. ; bp : Zeiger auf aktuellen Punkt
  1917.  
  1918. setnewlinel ;Linienvariablen laden
  1919. setnewliner
  1920.  
  1921. schleifel:
  1922. cmp ax,xl1
  1923. je neue_liniel ;wenn Ende erreicht -> neue Linie setzen
  1924. cmp bx,yl1
  1925. je neue_liniel ;sonst weiterzeichnen
  1926.  
  1927. or si,si ;Inkrement-Flag <= 0
  1928. jg flaglgross
  1929. incyl: ;Diese Stelle wird gepatcht !
  1930. inc bx ;y weiter
  1931. add si,dxl ;IncFlag weitersetzen
  1932.  
  1933. txt_incl ;auch 3D-Koordinaten weiter
  1934.  
  1935. cmp bx,yl1 ;Ziel erreicht ?
  1936. je neue_liniel ;dann neue Linie
  1937. jmp links_erh”ht ;Links wurde y erh”ht -> jetzt rechts
  1938. flaglgross:
  1939. sub si,dyl ;Inkflag runterz„hlen
  1940. incxl: ;Diese Stelle wird gepatcht !
  1941. inc ax ;x weiter
  1942. jmp schleifel
  1943.  
  1944. fertig__:
  1945. jmp fertig
  1946.  
  1947. neue_liniel:
  1948. mov bx,links ;Erh”hung vorbereiten
  1949. cmp bx,rechts
  1950. je fertig__ ;gleich, dann fertig
  1951. add bx,8 ;links weiter
  1952. mov ax,polyn ;Ist Links am Ende der Liste ?
  1953. shl ax,3
  1954. sub ax,8 ;Ende bestimmt
  1955. cmp bx,ax ;Vergleich
  1956. jb links_setzen
  1957. xor bx,bx ;wenn ja, dann auf 0 setzen
  1958. links_setzen:
  1959. mov links,bx
  1960. setnewlinel ;Variablen neu laden
  1961. jmp schleifel
  1962. fertig_:
  1963. jmp fertig
  1964. links_erh”ht:
  1965.  
  1966. schleifer:
  1967. cmp cx,xr1
  1968. je neue_linier ;wenn Ende erreicht -> neue Linie setzen
  1969. cmp dx,yr1
  1970. je neue_linier ;sonst weiterzeichnen
  1971.  
  1972. or di,di ;Inkrement-Flag <= 0
  1973. jg flagrgross
  1974. incyr: ;Diese Stelle wird gepatcht !
  1975. inc dx ;y weiter
  1976. add di,dxr ;IncFlag weitersetzen
  1977.  
  1978. txt_incr
  1979.  
  1980. cmp dx,yr1 ;Ziel erreicht ?
  1981. je neue_linier ;dann neue Linie
  1982. jmp rechts_erh”ht ;Rechts wurde y erh”ht -> jetzt Linie ziehen
  1983. flagrgross:
  1984. sub di,dyr ;Inkflag runterz„hlen
  1985. incxr:
  1986. inc cx ;Diese Stelle wird gepatcht !
  1987. jmp schleifer
  1988.  
  1989. neue_linier:
  1990. mov dx,rechts ;Verminderung vorbereiten
  1991. cmp dx,links
  1992. je fertig_ ;wenn gleich, dann fertig
  1993. sub dx,8 ;Wenn vorher auf 0->ans andere Ende setzen
  1994. jns rechts_setzen
  1995. mov dx,polyn
  1996. sub dx,2
  1997. shl dx,3 ;auf Ende positioniert
  1998. rechts_setzen:
  1999. mov rechts,dx
  2000.  
  2001. setnewliner ;Variablen neu laden
  2002. jmp schleifer
  2003.  
  2004. rechts_erh”ht:
  2005. push ax
  2006. push cx
  2007. cmp cx,ax ;richtige Reihenfolge ?
  2008. jae direct_ok ;dann ok, sonst:
  2009. cmp w fl_ruecken,0 ;Fl„chenrcken unterdrcken ?
  2010. je zeichnen ;nein, dann dennoch zeichnen
  2011. pop cx
  2012. pop ax
  2013. jmp fertig ;Polygon wird nicht gezeichnet
  2014. zeichnen:
  2015. xchg ax,cx ;Koordinaten in richtige Reihenfolge
  2016. direct_ok:
  2017.  
  2018. cmp texture,1 ;Texturen verwenden ?
  2019. jne norm_fuellen ;nein, dann normal fllen
  2020. call hline_texture ;horizontale Textur-Linie zeichnen
  2021. pop cx
  2022. pop ax
  2023. jmp schleifel ;und weiter
  2024. norm_fuellen:
  2025. call hline ;horizontale Linie zeichnen
  2026. pop cx
  2027. pop ax
  2028. jmp schleifel ;und weitermachen
  2029. fertig:
  2030. popa
  2031. pop bp
  2032. ret
  2033. fillpol endp
  2034. code ends
  2035. enddata segment
  2036. extrn vscreen:dword ;Zeiger auf Landschaftsdaten
  2037. extrn x,y: word ;Koordinaten des Trapez
  2038. extrn vpage:word ;aktuelle Bildschirmseite
  2039. data ends
  2040.  
  2041. code segment
  2042. assume cs:code,ds:data
  2043.  
  2044.  
  2045. ;Variablen mit Nachkommateil (untere 8 Bit):
  2046.  
  2047. offst dd 0 ;aktueller Offset
  2048. step dd 0 ;PixelgrӇe
  2049. row_start dd 0 ;Beginn der aktuellen Zeile
  2050. row_step dd 0 ;Abstand zur n„chsten Zeile
  2051.  
  2052.  
  2053. z_count dw 0 ;Z„hler fr die Tiefe
  2054. shrink dw 0 ;Korrektur am unteren Bildschirmrand
  2055.  
  2056. Zeile dd 0 ;aktuelle Bildschirm-Zeilennummer
  2057. vpage_cs dw 0 ;Bildschirmseite im Code-Segment
  2058.  
  2059.  
  2060. .386
  2061. public Draw_Voxel
  2062. Draw_Voxel proc pascal
  2063. ;stellt Landschaft auf aktueller Bildschirmseite dar
  2064. ;liest Daten aus vscreen ab Position (x/y)
  2065.  
  2066. mov ax,vpage ;Nummer der Bildschirmseite merken
  2067. mov vpage_cs,ax
  2068.  
  2069. push ds
  2070. mov ax,0a000h ;Zielsegment laden
  2071. mov es,ax
  2072.  
  2073. mov ax,320 ;Offset in Landschaft berechnen
  2074. imul y
  2075. add ax,x
  2076.  
  2077. lds si,vscreen ;Daten aus vscreen entnehmen
  2078. add si,ax ;Offset dazu
  2079. shl esi,8 ;in Festkommazahl umwandeln
  2080.  
  2081. mov offst,esi ;Startwerte fr Pixel ...
  2082. mov row_start,esi ;... und Zeile
  2083.  
  2084. mov step,100h ;zun„chst Skalierungs-Faktor 1
  2085. mov Zeile,100*256 ;in Bildschirmzeile 100 beginnen
  2086. mov row_step,14040h ;Abstand der Zeilen 320,25
  2087. mov shrink,0 ;zun„chst keine Korrektur
  2088. mov z_count,160 ;Anzahl zu berechnender Zeilen
  2089.  
  2090. next_y:
  2091. mov eax,Zeile ;aktuelle (Bildschirm-) Zeilennummer holen
  2092. mov ebx,eax ;sichern
  2093. shr eax,8 ;in ganze Zahl umwandeln
  2094. add eax,50 ;50 Pixel nach unten
  2095. imul eax,80 ;in Offset umrechnen
  2096. mov di,ax ;als Zielzeiger sichern
  2097.  
  2098. cmp di,199*80 ;Bildschirmrand berschritten ?
  2099. jb normal
  2100. mov di,199*80 ;ja, dann auf letzte Zeile positionieren
  2101.  
  2102. mov eax,Zeile ;Differenz zum unteren Bildschirmrand
  2103. shr eax,8
  2104. sub eax,149
  2105. mov shrink,ax ;und als Korrektur merken
  2106.  
  2107. normal:
  2108. add di,vpage_cs ;aktuelle Bildschirmseite dazu
  2109.  
  2110. imul ebx,16500 ;Zeilennummer mit 1.007 multiplizieren
  2111. shr ebx,14 ;dazu * 16500 / 16384 rechnen
  2112. mov Zeile,ebx ;und sichern
  2113.  
  2114. mov bp,80 ;Anzahl Pixel pro Zeile
  2115. next_x:
  2116. mov esi,offst ;aktuellen Pixel-Offset laden
  2117. shr esi,8 ;in ganze Zahl wandeln
  2118. xor eax,eax
  2119. mov al,[si] ;Punkt aus Landschaft laden
  2120. mov cx,ax ;sichern
  2121.  
  2122. cmp cx,99 ;Farbe (=H”he) < 100
  2123. ja fill_bar
  2124. mov ax,99 ;dann auf 99 setzen
  2125.  
  2126. fill_bar:
  2127. shl ax,5 ;Fluchtpunkt-Projektion: H”he * 32
  2128. xor dx,dx
  2129. push bp
  2130. mov bp,z_count ;dividiert durch die Entfernung
  2131. add bp,50
  2132. idiv bp
  2133. pop bp
  2134.  
  2135. sub ax,shrink ;Korrektur durchfhren
  2136. jbe weiter ;wenn <= 0, gar nicht zeichnen
  2137.  
  2138. push di
  2139. next_fill:
  2140. mov es:[di],cl ;Farbe eintragen
  2141. sub di,80 ;n„chsth”here Zeile ansprechen
  2142. dec al ;Z„hler verringern
  2143. jne next_fill ;weitermachen ?
  2144. pop di
  2145.  
  2146. weiter:
  2147. inc di ;n„chstes Byte auf dem Bildschirm ansprechen
  2148. mov esi,step ;Schrittweite holen
  2149. add esi,offst ;aufaddieren
  2150. mov offst,esi ;und zurckschreiben
  2151.  
  2152. dec bp ;n„chsten Punkt
  2153. jne next_x
  2154.  
  2155. mov esi,row_step ;Start der Zeile verschieben
  2156. add esi,row_start
  2157. mov row_start,esi
  2158. mov offst,esi ;auch Pixel-Offset neu laden
  2159.  
  2160. dec step ;Skalierungsfaktor herunterz„hlen
  2161. dec z_count ;Zeilenz„hler weiter
  2162. jne next_y
  2163. pop ds
  2164. ret
  2165. Draw_Voxel endp
  2166.  
  2167. code ends
  2168. end
  2169. extrn WaitRetrace:far
  2170.  
  2171. data segment public
  2172. extrn sinus:dataptr ;Sinustabelle
  2173. data ends
  2174.  
  2175.  
  2176. code segment public
  2177. assume cs:code,ds:data
  2178.  
  2179. public make_wob
  2180. make_wob proc pascal wob_pos,wob_hoehe,wob_offset:word
  2181. xor cx,cx ;Zeilenz„hler auf 0
  2182. call waitretrace ;Synchronisation mit Kathodenstrahl
  2183.  
  2184. next_line:
  2185. inc cx ;Zeilenz„hler hoch
  2186.  
  2187. mov bx,cx ;Position innerhalb des Wobblers bestimmen
  2188. sub bx,wob_pos
  2189. mov si,bx ;merken fr Schluá
  2190.  
  2191. add bx,wob_offset ;Offset drauf fr Bewegung
  2192. and bx,63 ;nur Werte von 0..63 erlauben (ArraygrӇe)
  2193. shl bx,1 ;Arrayzugriff auf Words
  2194. mov bx,sinus[bx] ;Wert holen in bx
  2195.  
  2196. cli ;Interrupts l”schen, da SEHR zeitkritisch
  2197. mov dx,3dah ;Input Status Register 1 selektieren
  2198.  
  2199. in_display:
  2200. in al,dx ;Warten auf (Horizontal-) Retrace
  2201. test al,1
  2202. je in_display
  2203. in_retrace:
  2204. in al,dx ;auf Display warten
  2205. test al,1
  2206. jne in_retrace
  2207.  
  2208. cmp cx,wob_pos ;gewnschte Zeile erreicht ?
  2209. jb next_line ;nein -> Standarwert setzen
  2210.  
  2211. mov dx,3d4h ;CRTC-Register 4 (Horizontal Sync Start)
  2212. mov al,4 ;selektieren
  2213. mov ah,bl ;Sinus-Wert holen
  2214. out dx,ax ;und eintragen
  2215.  
  2216. cmp si,wob_hoehe ;Ende erreicht ?
  2217. jb next_line
  2218.  
  2219. mov dx,3dah
  2220. warten:
  2221. in al,dx ;Warten auf (Horizontal-) Retrace
  2222. test al,1
  2223. jne warten
  2224. mov dx,3d4h ;Sync Start wieder normal setzen
  2225. mov ax,5504h
  2226. out dx,ax
  2227. sti ;Interrupts wieder zulassen
  2228. ret
  2229. make_wob endp
  2230.  
  2231. code ends
  2232. end
  2233. Uses Crt,ModeXLib,var_3d;
  2234.  
  2235. Const
  2236. worldlen=8*3; {Punkte-Array}
  2237. Worldconst:Array[0..worldlen-1] of Integer =
  2238. (-200,-200,-200,
  2239. -200,-200,200,
  2240. -200,200,-200,
  2241. -200,200,200,
  2242. 200,-200,-200,
  2243. 200,-200,200,
  2244. 200,200,-200,
  2245. 200,200,200);
  2246. surfclen=38; {Fl„chen-Array}
  2247. surfcconst:Array[0..surfclen-1] of Word=
  2248. (0,4, 0,2,6,4,
  2249. 0,4, 0,1,3,2,
  2250. 0,4, 4,6,7,5,
  2251. 0,4, 1,5,7,3,
  2252. 0,4, 2,3,7,6,
  2253. 0,4, 0,4,5,1,0,0);
  2254.  
  2255. Var
  2256. i,j:Word;
  2257.  
  2258.  
  2259. procedure drawworld;external; {zeichnet die Welt auf akt. Bildschirmseite}
  2260. {$l 3dasm.obj}
  2261. {$l poly.obj}
  2262. {$l bres.obj}
  2263. {$l wurzel.obj}
  2264.  
  2265. Begin
  2266. vz:=1000; {K”rper befindet sich bei 1000 Einh. Tiefe}
  2267. vpage:=0; {mit Seite 0 beginnen}
  2268. init_modex; {ModeX einschalten}
  2269. rotx:=0; {Startwerte fr Rotation}
  2270. roty:=0;
  2271. rotz:=0;
  2272. Fuellen:=false; {Fl„chenfllen aus}
  2273. fl_sort:=false; {Fl„chensortierung aus}
  2274. fl_ruecken:=false; {Fl„chenrckeunterdrckung aus}
  2275. Glas:=false; {Glas-Oberfl„chen aus}
  2276. repeat
  2277. clrx($0f); {Bildschirm l”schen}
  2278. DrawWorld; {Welt zeichnen}
  2279. switch; {auf fertiges Bild schalten}
  2280. WaitRetrace; {n„chsten Retrace abwarten}
  2281. Inc(rotx); {weiterrotieren ... }
  2282. If rotx=120 Then rotx:=0;
  2283. Inc(rotz);
  2284. If rotz=120 Then rotz:=0;
  2285. inc(roty);
  2286. if roty=120 Then roty:=0;
  2287. Until KeyPressed; { ... bis Taste}
  2288. TextMode(3);
  2289. End.
  2290. Uses Crt,ModeXLib,var_3d;
  2291.  
  2292. Const
  2293. worldlen=8*3; {Punkte-Array}
  2294. Worldconst:Array[0..worldlen-1] of Integer =
  2295. (-200,-200,-200,
  2296. -200,-200,200,
  2297. -200,200,-200,
  2298. -200,200,200,
  2299. 200,-200,-200,
  2300. 200,-200,200,
  2301. 200,200,-200,
  2302. 200,200,200);
  2303. surfclen=38; {Fl„chen-Array}
  2304. surfcconst:Array[0..surfclen-1] of Word=
  2305. (01,4, 0,2,6,4,
  2306. 02,4, 0,1,3,2,
  2307. 04,4, 4,6,7,5,
  2308. 08,4, 1,5,7,3,
  2309. 16,4, 2,3,7,6,
  2310. 32,4, 0,4,5,1,0,0);
  2311.  
  2312. Var
  2313. i,j:Word;
  2314.  
  2315. Procedure Glas_Pal;
  2316. {bereitet die Palette auf Glas-K”rper vor}
  2317. Begin
  2318. FillChar(Palette[3],765,63); {zun„chst alle Farben weiá}
  2319. For i:=1 to 255 do Begin {255 Mischfarben bestimmen}
  2320. If i and 1 = 1 Then Dec(Palette[i*3],16);
  2321. If i and 2 = 2 Then Dec(Palette[i*3+1],16);
  2322. If i and 4 = 4 Then Dec(Palette[i*3+2],16);
  2323. If i and 8 = 8 Then Begin
  2324. Dec(Palette[i*3],16);
  2325. Dec(Palette[i*3+1],16);
  2326. End;
  2327. If i and 16 = 16 Then Begin
  2328. Dec(Palette[i*3],16);
  2329. Dec(Palette[i*3+2],16);
  2330. End;
  2331. If i and 32 = 32 Then Begin
  2332. Dec(Palette[i*3+1],16);
  2333. Dec(Palette[i*3+2],16);
  2334. End;
  2335. End;
  2336. SetPal;
  2337. End;
  2338.  
  2339. procedure drawworld;external; {zeichnet die Welt auf akt. Bildschirmseite}
  2340. {$l 3dasm.obj}
  2341. {$l poly.obj}
  2342. {$l bres.obj}
  2343. {$l wurzel.obj}
  2344.  
  2345. Begin
  2346. vz:=1000; {K”rper befindet sich bei 1000 Einh. Tiefe}
  2347. vpage:=0; {mit Seite 0 beginnen}
  2348. init_modex; {ModeX einschalten}
  2349. Glas_Pal;
  2350. rotx:=0; {Startwerte fr Rotation}
  2351. roty:=0;
  2352. rotz:=0;
  2353. Fuellen:=true; {Fl„chenfllen ein}
  2354. fl_sort:=false; {Fl„chensortierung aus}
  2355. fl_ruecken:=false; {Fl„chenrckeunterdrckung aus}
  2356. Glas:=true; {Glas-Oberfl„chen ein}
  2357. repeat
  2358. clrx($0f); {Bildschirm l”schen}
  2359. DrawWorld; {Welt zeichnen}
  2360. switch; {auf fertiges Bild schalten}
  2361. WaitRetrace; {n„chsten Retrace abwarten}
  2362. Inc(rotx); {weiterrotieren ... }
  2363. If rotx=120 Then rotx:=0;
  2364. Inc(rotz);
  2365. If rotz=120 Then rotz:=0;
  2366. inc(roty);
  2367. if roty=120 Then roty:=0;
  2368. Until KeyPressed; { ... bis Taste}
  2369. TextMode(3);
  2370. End.
  2371. Uses Crt,ModeXLib,Gif,var_3d;
  2372.  
  2373. Const
  2374. worldlen=8*3; {Punkte-Array}
  2375. Worldconst:Array[0..worldlen-1] of Integer =
  2376. (-200,-200,-200,
  2377. -200,-200,200,
  2378. -200,200,-200,
  2379. -200,200,200,
  2380. 200,-200,-200,
  2381. 200,-200,200,
  2382. 200,200,-200,
  2383. 200,200,200);
  2384. surfclen=38; {Fl„chen-Array}
  2385. surfcconst:Array[0..surfclen-1] of Word=
  2386. ($fee0,4, 0,2,6,4,
  2387. $fec0,4, 0,1,3,2,
  2388. $fec0,4, 4,6,7,5,
  2389. $fee0,4, 1,5,7,3,
  2390. $fec0,4, 2,3,7,6,
  2391. $fec0,4, 0,4,5,1,0,0);
  2392. { $fe = Lichtquelle benutzen, Grundfarbe im Low-Byte}
  2393.  
  2394. Var
  2395. i,j:Word;
  2396.  
  2397. Procedure Schatt_Pal; {Palette auf Schattierung vorbereiten}
  2398. Begin
  2399. For j:=192 to 223 do Begin {Farben 192 - 223 und 224 - 255 vorbereiten}
  2400. i:=trunc((j/32)*43); {Helligkeit ermitteln}
  2401. Fillchar(Palette[j*3],3,i+20); {Farben 192-223 auf Grauwerte}
  2402.  
  2403. Palette[(j+32)*3]:=i+20; {Farben 224-255 auf Rotwerte}
  2404. Palette[(j+32)*3+1]:=0;
  2405. Palette[(j+32)*3+2]:=0;
  2406. End;
  2407. Setpal; {Diese Palette setzen}
  2408. End;
  2409.  
  2410. procedure drawworld;external; {zeichnet die Welt auf akt. Bildschirmseite}
  2411. {$l 3dasm.obj}
  2412. {$l poly.obj}
  2413. {$l bres.obj}
  2414. {$l wurzel.obj}
  2415.  
  2416. Begin
  2417. vz:=1000; {K”rper befindet sich bei 1000 Einh. Tiefe}
  2418. vpage:=0; {mit Seite 0 beginnen}
  2419. LoadGif('logor.gif'); {Hintergrundbild laden}
  2420. init_modex; {ModeX einschalten}
  2421. Schatt_Pal; {Schattier-Palette berechnen}
  2422. rotx:=0; {Startwerte fr Rotation}
  2423. roty:=0;
  2424. rotz:=0;
  2425. Fuellen:=true; {Fl„chenfllen ein}
  2426. fl_sort:=true; {Fl„chensortierung ein}
  2427. fl_ruecken:=true; {Fl„chenrckeunterdrckung ein}
  2428. Glas:=false; {Glas-Oberfl„chen aus}
  2429. p13_2_modex(16000*2,16000); {Hintergrund auf VGA-Seite 2}
  2430. repeat
  2431. CopyScreen(vpage,16000*2); {Hintergrundbild auf aktuelle Seite}
  2432. DrawWorld; {Welt zeichnen}
  2433. switch; {auf fertiges Bild schalten}
  2434. WaitRetrace; {n„chsten Retrace abwarten}
  2435. Inc(rotx); {weiterrotieren ... }
  2436. If rotx=120 Then rotx:=0;
  2437. Inc(rotz);
  2438. If rotz=120 Then rotz:=0;
  2439. inc(roty);
  2440. if roty=120 Then roty:=0;
  2441. Until KeyPressed; { ... bis Taste}
  2442. TextMode(3);
  2443. End.
  2444. Uses Crt,ModeXLib,var_3d;
  2445.  
  2446. Const
  2447. worldlen=8*3; {Punkte-Array}
  2448. Worldconst:Array[0..worldlen-1] of Integer =
  2449. (-200,-200,-200,
  2450. -200,-200,200,
  2451. -200,200,-200,
  2452. -200,200,200,
  2453. 200,-200,-200,
  2454. 200,-200,200,
  2455. 200,200,-200,
  2456. 200,200,200);
  2457. surfclen=38; {Fl„chen-Array}
  2458. surfcconst:Array[0..surfclen-1] of Word=
  2459. (01,4, 0,2,6,4,
  2460. 02,4, 0,1,3,2,
  2461. 03,4, 4,6,7,5,
  2462. 04,4, 1,5,7,3,
  2463. 05,4, 2,3,7,6,
  2464. 06,4, 0,4,5,1,0,0);
  2465.  
  2466. Var
  2467. i,j:Word;
  2468.  
  2469. procedure drawworld;external; {zeichnet die Welt auf akt. Bildschirmseite}
  2470. {$l 3dasm.obj}
  2471. {$l poly.obj}
  2472. {$l bres.obj}
  2473. {$l wurzel.obj}
  2474.  
  2475. Begin
  2476. vz:=1000; {K”rper befindet sich bei 1000 Einh. Tiefe}
  2477. vpage:=0; {mit Seite 0 beginnen}
  2478. init_modex; {ModeX einschalten}
  2479. rotx:=0; {Startwerte fr Rotation}
  2480. roty:=0;
  2481. rotz:=0;
  2482. Fuellen:=true; {Fl„chenfllen ein}
  2483. fl_sort:=true; {Fl„chensortierung ein}
  2484. fl_ruecken:=true; {Fl„chenrckeunterdrckung ein}
  2485. Glas:=false; {Glas-Oberfl„chen aus}
  2486. repeat
  2487. clrx($0f); {Bildschirm l”schen}
  2488. DrawWorld; {Welt zeichnen}
  2489. switch; {auf fertiges Bild schalten}
  2490. WaitRetrace; {n„chsten Retrace abwarten}
  2491. Inc(rotx); {weiterrotieren ... }
  2492. If rotx=120 Then rotx:=0;
  2493. Inc(rotz);
  2494. If rotz=120 Then rotz:=0;
  2495. inc(roty);
  2496. if roty=120 Then roty:=0;
  2497. Until KeyPressed; { ... bis Taste}
  2498. TextMode(3);
  2499. End.
  2500. Uses Crt,ModeXLib,Gif,var_3d;
  2501.  
  2502. Const
  2503. worldlen=8*3; {Punkte-Array}
  2504. Worldconst:Array[0..worldlen-1] of Integer =
  2505. (-200,-200,-200,
  2506. -200,-200,200,
  2507. -200,200,-200,
  2508. -200,200,200,
  2509. 200,-200,-200,
  2510. 200,-200,200,
  2511. 200,200,-200,
  2512. 200,200,200);
  2513. surfclen=38; {Fl„chen-Array}
  2514. surfcconst:Array[0..surfclen-1] of Word=
  2515. ($ff00,4, 0,2,6,4,
  2516. $ff01,4, 0,1,3,2,
  2517. $ff02,4, 4,6,7,5,
  2518. $ff00,4, 1,5,7,3,
  2519. $ff03,4, 2,3,7,6,
  2520. $ff04,4, 0,4,5,1,0,0);
  2521.  
  2522. { $ff = Texturen benutzen, Nummer im Low-Byte}
  2523.  
  2524. Var
  2525. i,j:Word;
  2526.  
  2527. Procedure Prep_Texturen;
  2528. {Variablen der Texturen laden}
  2529. Begin
  2530. LoadGif('Textur'); {Textur-Bild laden}
  2531. GetMem(Txt_Pic,64000); {Speicher dafr holen}
  2532. Move(VScreen^,Txt_Pic^,64000);{und dorthin kopieren}
  2533. For i:=0 to Txt_Anzahl-1 do Begin
  2534. Txt_Daten[i]:=Txt_Pic; {Zeiger auf Daten laden}
  2535. Txt_Offs[i]:=i*64; {Offset bestimmen}
  2536. End;
  2537. End;
  2538.  
  2539. procedure drawworld;external; {zeichnet die Welt auf akt. Bildschirmseite}
  2540. {$l 3dasm.obj}
  2541. {$l poly.obj}
  2542. {$l bres.obj}
  2543. {$l wurzel.obj}
  2544.  
  2545. Begin
  2546. vz:=1000; {K”rper befindet sich bei 1000 Einh. Tiefe}
  2547. vpage:=0; {mit Seite 0 beginnen}
  2548. init_modex; {ModeX einschalten}
  2549. Prep_Texturen;
  2550. LoadGif('logo.gif'); {Hintergrundbild laden}
  2551. rotx:=0; {Startwerte fr Rotation}
  2552. roty:=0;
  2553. rotz:=0;
  2554. Fuellen:=true; {Fl„chenfllen ein}
  2555. fl_sort:=true; {Fl„chensortierung ein}
  2556. fl_ruecken:=true; {Fl„chenrckeunterdrckung ein}
  2557. Glas:=false; {Glas-Oberfl„chen aus}
  2558. p13_2_modex(16000*2,16000); {Hintergrund auf VGA-Seite 2}
  2559. repeat
  2560. CopyScreen(vpage,16000*2); {Hintergrundbild auf aktuelle Seite}
  2561. DrawWorld; {Welt zeichnen}
  2562. switch; {auf fertiges Bild schalten}
  2563. WaitRetrace; {n„chsten Retrace abwarten}
  2564. Inc(rotx); {weiterrotieren ... }
  2565. If rotx=120 Then rotx:=0;
  2566. Inc(rotz);
  2567. If rotz=120 Then rotz:=0;
  2568. inc(roty);
  2569. if roty=120 Then roty:=0;
  2570. Until KeyPressed; { ... bis Taste}
  2571. TextMode(3);
  2572. End.
  2573. Uses Crt,ModeXLib;
  2574. var y1, {y-Position Copper 1}
  2575. y1_dir, {y-Richtung Copper 1}
  2576. Maske:Word; {Overlay-Maske, fr šberlagerung der Copper}
  2577.  
  2578. Procedure MakeCopper(y_pos1,y_pos2,overlay_maske:word);external;
  2579. {$l copper}
  2580.  
  2581. begin
  2582. TextMode(3); {Copper funktioniert in JEDEM Videomodus ! }
  2583. y1:=Port[$3da]; {ATC in Index-Mode schalten}
  2584. Port[$3c0]:=$11 or 32; {Register 11h w„hlen}
  2585. Port[$3c0]:=255; {Rahmenfarbe 255}
  2586. y1:=0; {Start am oberen Bildschirmrand}
  2587. y1_dir:=2; {Bewegung zun„chst nach unten}
  2588. Maske:=$00ff; {zun„chst Copper 1 (rot) im Vordergrund}
  2589. Repeat
  2590. Inc(y1,y1_dir); {Copper-Bewegung}
  2591. If (y1<=0) or (y1>=150) {am Rand : }
  2592. then Begin
  2593. y1_dir:=-y1_dir; {Richtung umkehren}
  2594. Maske:=Swap(Maske); {jew. anderen Copper in Vordergrund}
  2595. End;
  2596. Write('D i e s i s t e i n D e m o t e x t ');
  2597. MakeCopper(y1,150-y1,Maske);{Copper zeichnen}
  2598. Until KeyPressed;
  2599. End.
  2600. Uses Crt,ModeXLib,Gif,Font;
  2601.  
  2602. Var Eingabe:Char; {gerade eingegebenes Zeichen}
  2603.  
  2604. Begin
  2605. Init_ModeX; {Mode X ein}
  2606. LoadGif('pfont4'); {Zeichensatz laden}
  2607. p13_2_ModeX(48000,16000); {und auf Seite 3 kopieren}
  2608.  
  2609. Repeat {Schleife zum Ausgeben von Tastatureingaben}
  2610. Eingabe:=ReadKey; {Zeichen holen}
  2611. Print_Char(Eingabe); {und auf Monitor bringen}
  2612. Until Eingabe=#27; {bis Esc gedrckt}
  2613.  
  2614. Print_String('hallo, test'); {zum Abschluá noch einen String ausgeben}
  2615. ReadLn;
  2616. TextMode(3);
  2617. End.
  2618. Unit fade;
  2619. {verwendet zum šberblenden eines gerade angezeigten Bild(teil)s
  2620. in ein neues}
  2621.  
  2622. Interface
  2623. Uses ModeXLib;
  2624.  
  2625. Var Colors:Word; {Anzahl Farben pro Einzelbild}
  2626.  
  2627. Procedure fade_ResetPic(y,Hoehe:Word);
  2628. Procedure Ueberblenden(Pic:Pointer;Pal:Array of Byte; Start,y,Hoehe:Word);
  2629.  
  2630.  
  2631. Implementation
  2632. Var i,j:Word; {tempor„re Z„hler}
  2633. Ziel_Pal:Array[0..768] of Byte; {tempor„re Zielpalette}
  2634.  
  2635. Procedure fade_set(Quelle:Pointer;Start,y,Hoehe:Word);external;
  2636. {"mischt" Quelle mit VGA-Ram}
  2637. {dabei Quelle ab Zeile Start und VGA-Ram ab Zeile y bei H”he Hoehe verwenden}
  2638.  
  2639. Procedure fade_ResetPic(y,Hoehe:Word);external;
  2640. {bereitet bergeblendetes Bild auf erneutes Faden vor}
  2641. {dazu Reduktion von "Colors^2" auf "Colors" Farben}
  2642. {auch hier y=Zeile im VGA-Ram, Hoehe=H”he des zu bearbeitenden Bereichs}
  2643.  
  2644. {$l fade}
  2645.  
  2646.  
  2647. Procedure fade_CopyPal;
  2648. {Palette auf Colors^2 vervielfachen (nichthomogenen Block 0 vervielfachen)}
  2649. Begin
  2650. For i:=1 to Colors do
  2651. Move(Palette[0],Palette[i*3*Colors],Colors*3);
  2652.  
  2653. End;
  2654.  
  2655. Procedure fade_spreizen(Var Pal:Array of Byte);
  2656. {Palette auf Colors^2 spreizen (jede Farbe einzeln vervielfachen)}
  2657. {hier werden aus den Farben 0..Colors-1 die homogenen Bl”cke gebildet}
  2658. Begin
  2659. For i:= 0 to Colors-1 do {jede Farbe einzeln bearbeiten}
  2660. For j:=0 to Colors -1 do {jeweils Colors mal schreiben}
  2661. Move(Pal[i*3],Pal[(i+1)*3*Colors+j*3],3);
  2662. End;
  2663.  
  2664. Procedure Ueberblenden(Pic:Pointer;Pal:Array of Byte; Start,y,Hoehe:Word);
  2665. {Blendet von aktuell sichtbarem Bild auf Pic (mit Palette Pal) ber
  2666. dabei wird in Zeile "Start" von Pic begonnen, "Hoehe" Zeilen zur
  2667. y-Koordinate y des aktuellen Bilds zu kopieren}
  2668. Begin
  2669. WaitRetrace; {Synchronisation}
  2670. fade_CopyPal; {in aktueller Palette Block vervielfachen}
  2671. SetPal; {diese Palette neu setzen}
  2672. Move(Palette,Ziel_Pal,768); {originale Palettenteile beibehalten}
  2673. Move(pal,Ziel_Pal,Colors*3); {Zielpalette laden}
  2674. fade_spreizen(Ziel_pal); {Zielpaletten-Blocks spreizen}
  2675. fade_set(pic,start,y,hoehe); {neues Bild dazumischen}
  2676. fade_to(Ziel_pal,1); {und berblenden}
  2677. End;
  2678.  
  2679. Begin
  2680. Colors:=15; {nur Defaultwert !}
  2681. End.
  2682. uses crt,ModeXLib,Tools;
  2683. var i,j:word;
  2684. zielpal:Array[0..767] of Byte;
  2685.  
  2686. Procedure Fade_in(ZPal:Array of Byte);
  2687. Begin
  2688. For j:=0 to 63 do Begin {64 Durchl„ufe, um komplett zu faden}
  2689. For i:=0 to 767 do {768 Farbwerte berechnen}
  2690. If Palette[i] < ZPal[i] {aktueller Wert noch kleiner als Zielwert ?}
  2691. Then Inc(Palette[i]); {dann erh”hen}
  2692. WaitRetrace; {Synchronisation}
  2693. SetPal; {berechnete Palette setzen}
  2694. End;
  2695. End;
  2696.  
  2697. begin
  2698. ClrScr; {Bildschirm l”schen}
  2699. GetPal; {"Palette" mit aktuelle DAC-Palette laden}
  2700. Move(Palette,Zielpal,768); {Palette sichern}
  2701. FillChar(Palette,768,0); {alte Palette l”schen}
  2702. SetPal; {und setzen}
  2703.  
  2704. Draw_Ansi('color.ans'); {Hintergrundbild laden}
  2705.  
  2706. ReadLn;
  2707. fade_in(Zielpal); {Bild auf Zielpal (originale Palette) faden}
  2708. ReadLn;
  2709. TextMode(3); {Normalzustand herstellen}
  2710. End.
  2711. uses crt,modexlib,Tools;
  2712. var i:word;
  2713.  
  2714. Begin
  2715. GetPal; {"Palette" mit aktuelle DAC-Palette laden}
  2716. Draw_Ansi('color.ans'); {Bild laden}
  2717. Setpal;
  2718. ReadLn;
  2719. Fade_out; {Bild ausblenden}
  2720. ReadLn;
  2721. TextMode(3); {wieder normales Bild}
  2722. End.uses Crt,ModeXLib,gif,fade;
  2723. Var pic1_pal, {Paletten der beiden Bilder}
  2724. pic2_pal:Array[0..767] of Byte;
  2725. pic1, {beinhaltet 1.Bild}
  2726. pic2:Pointer; {2. Bild, ist gleich vscreen}
  2727.  
  2728. Begin
  2729. Init_Mode13; {Mode 13h ein}
  2730. Screen_off; {Bildschirm aus w„hren Ladens}
  2731. LoadGif('schach'); {erstes Bild laden}
  2732. GetMem(pic1,64000); {Speicher fr 1.Bild holen}
  2733. Move(vscreen^,pic1^,64000); {in pic1 sichern}
  2734. Move(Palette,pic1_pal,768); {und die Palette sichern}
  2735. Show_Pic13; {dieses Bild auf Screen}
  2736.  
  2737. LoadGif('kiste'); {n„chstes in vscreen^ Laden}
  2738. pic2:=vscreen; {pic2 als Zeiger darauf verwendet}
  2739. Move(Palette,pic2_pal,768); {dessen Palette sichern}
  2740.  
  2741. Move(pic1_pal,Palette,768); {Palette von Bild 1 aktivieren}
  2742. SetPal; {und setzen}
  2743. Screen_on; {jetzt Bildschirm wieder einschalten}
  2744.  
  2745. ReadLn; {warten}
  2746. Ueberblenden(pic2,pic2_pal,0,0,200);
  2747. {und dann Bild 2 einblenden)}
  2748.  
  2749. fade_ResetPic(0,200); {erneutes Faden vorbereiten}
  2750. ReadLn;
  2751. Ueberblenden(pic1,pic1_pal,0,0,200);
  2752. {und Bild 1 einblenden}
  2753.  
  2754. ReadLn;
  2755. TextMode(3);
  2756. End.
  2757. uses crt,ModeXLib,Tools;
  2758. var i:word;
  2759. origpal,
  2760. zielpal:Array[0..767] of Byte;
  2761.  
  2762. begin
  2763. ClrScr;
  2764. GetPal; {"Palette" mit aktuelle DAC-Palette laden}
  2765. Move(Palette,OrigPal,768); {Palette sichern}
  2766. Move(Palette,Zielpal,768); {Ziel-Palette bestimmen}
  2767.  
  2768. Draw_Ansi('color.ans'); {Ansi-Bild laden}
  2769.  
  2770. Make_bw(ZielPal); {ZielPal auf schwarz/weiá ziehen}
  2771. readkey;
  2772. fade_to(ZielPal,1); {schwarz/weiáe Palette einblenden}
  2773. ReadKey;
  2774. fade_to(OrigPal,1); {Original-Palette einblenden}
  2775.  
  2776. ReadLn;
  2777. TextMode(3); {Normalzustand herstellen}
  2778. End.
  2779. Uses Crt,Gif,ModeXLib,Fade;
  2780. Var
  2781. Text_Pal:Array[0..767] of Byte;
  2782. i:word;
  2783.  
  2784. Begin
  2785. Init_Mode13; {Mode 13h benutzen}
  2786. Screen_Off; {Bildschirm beim Laden aus}
  2787. LoadGif('vflog210'); {statischen Teil laden}
  2788. Move(Palette[210*3], {dessen Palettenteil (Farben 210..255)}
  2789. Text_Pal[210*3],46*3); {eintragen}
  2790. Show_Pic13; {statisches Bild in VGA kopieren}
  2791.  
  2792. LoadGif('texte'); {Bild mit Texten laden}
  2793. Move(Palette,Text_Pal,14*3); {dessen Palettenteil (Farben 0..13)}
  2794. {eintragen}
  2795. Move(Text_Pal,Palette,768); {fertige Palette setzen}
  2796. SetPal;
  2797.  
  2798. Move(vscreen^, {erster Text kann direkt auf Bildschirm}
  2799. Ptr($a000,160*320)^,19*320);{kopiert werden}
  2800. Screen_On; {jetzt Bild fertig -> einschalten}
  2801. Colors:=14; {in diesem Programm Bilder mit 14 Farben !}
  2802.  
  2803. For i:=1 to 6 do Begin {nacheinander die 6 weiteren Texte einblenden}
  2804. Delay(500); {Zeit zum Lesen}
  2805. Ueberblenden(vscreen, {n„chstes Bild an alte Position (y=160) faden}
  2806. text_pal,i*20,160,19);
  2807. Fade_ResetPic(160,19); {und "resetten"}
  2808. If KeyPressed Then Exit; {wer genug hat, kann hier abbrechen}
  2809. End;
  2810.  
  2811. Readln;
  2812. TextMode(3);
  2813. End.
  2814. {$G+}
  2815. Uses Crt,ModeXLib;
  2816. Type Block=Array[0..99,0..319] of Byte;
  2817. Var
  2818. Src_Frame, {vorheriges Bild}
  2819. Dest_Frame:^Block; {aktuelles Bild}
  2820.  
  2821. Procedure Scroll_Up;assembler;
  2822. {scrollt das Bild um eine Zeile nach oben und interpoliert}
  2823. asm
  2824. push ds
  2825. les di,Dest_Frame {Zeiger auf Zielbild laden}
  2826. lds si,Src_Frame {Zeiger auf Quellbild}
  2827. add si,320 {im Quellbild auf Zeile 1}
  2828. mov cx,320*98 {99 Zeilen scrollen}
  2829. xor bl,bl {wird als Dummy fr High-Byte ben”tigt}
  2830. @lp1:
  2831. xor ax,ax
  2832. xor bx,bx
  2833. mov al,[si-321] {ersten Punkt holen}
  2834. mov bl,[si-320] {zweiten Punkt addieren}
  2835. add ax,bx
  2836. mov bl,[si-319] {n„chsten Punkt addieren}
  2837. add ax,bx
  2838. mov bl,[si-1] {usw...}
  2839. add ax,bx
  2840. mov bl,[si+1]
  2841. add ax,bx
  2842. mov bl,[si+319]
  2843. add ax,bx
  2844. mov bl,[si+320]
  2845. adc ax,bx
  2846. mov bl,[si+321]
  2847. adc ax,bx
  2848. shr ax,3
  2849.  
  2850. or ax,ax {bereits 0 ?}
  2851. je @null
  2852. dec al {wenn nein, dann verringern}
  2853. @null:
  2854. stosb {Wert ins Ziel}
  2855. inc si {n„chsten Punkt}
  2856. dec cx {weitere Punkte ?}
  2857. jne @lp1
  2858. pop ds
  2859. End;
  2860.  
  2861. Procedure New_Line; {baut die untersten Zeilen neu auf}
  2862. Var i,x:Word;
  2863. Begin
  2864. For x:=0 to 319 do Begin {untere 3 Zeilen mit zuf„lligen Werten fllen}
  2865. Dest_Frame^[97,x]:=Random(15)+64;
  2866. Dest_Frame^[98,x]:=Random(15)+64;
  2867. Dest_Frame^[99,x]:=Random(15)+64;
  2868. End;
  2869. For i:=0 to Random(45) do Begin {zuf. Anzahl Hotspots einfgen}
  2870. x:=Random(320); {an zuf„llige Koordinaten}
  2871. asm
  2872. les di,Dest_Frame {Zielbild adressieren}
  2873. add di,98*320 {Zeile 98 (zweitunterste) bearbeiten}
  2874. add di,x {x-Koordinate dazu}
  2875. mov al,0ffh {hellste Farbe}
  2876. mov es:[di-321],al {groáen Hotspot erzeugen (9 Punkte)}
  2877. mov es:[di-320],al
  2878. mov es:[di-319],al
  2879. mov es:[di-1],al
  2880. mov es:[di],al
  2881. mov es:[di+1],al
  2882. mov es:[di+319],al
  2883. mov es:[di+320],al
  2884. mov es:[di+321],al
  2885. End;
  2886. End;
  2887. End;
  2888.  
  2889. Procedure Show_Screen; {kopiert fertigen Bilschirm auf VGA}
  2890. Var temp:Pointer; {zum Tauschen der Zeiger}
  2891. Begin
  2892. asm
  2893. push ds
  2894. lds si,Dest_Frame {fertiges Bild als Quelle}
  2895. mov ax,0a000h {VGA als Ziel}
  2896. mov es,ax
  2897. mov di,320*100 {ab Zeile 100}
  2898. mov cx,320*100/4 {100 Zeilen als Dwords kopieren}
  2899. db 66h {Operand Size Prefix (32 Bit)}
  2900. rep movsw {kopieren}
  2901. pop ds
  2902. End;
  2903. temp:=Dest_Frame; {Zeiger auf Quell- und Zielbild tauschen}
  2904. Dest_Frame:=Src_Frame;
  2905. Src_Frame:=temp;
  2906. End;
  2907.  
  2908. Procedure Prep_Pal; {Palette auf Flames vorbereiten}
  2909. Var i:Word;
  2910. Begin
  2911. FillChar(Palette,80*3,0); {Grundlage: alles schwarz}
  2912. For i:=0 to 7 do Begin
  2913. Palette[i*3+2]:=i*2; {Farbe 0-7: Anstieg Blau}
  2914. Palette[(i+8)*3+2]:=16-i*2; {Farbe 0-7: abfallendes Blau}
  2915. End;
  2916. For i:=8 to 31 do {Farbe 8 -31: Anstieg Rot}
  2917. Palette[i*3]:=(i-8)*63 div 23;
  2918. For i:=32 to 55 do Begin {Farbe 32-55: Anstieg Grn, Rot konstant}
  2919. Palette[i*3]:=63;
  2920. Palette[i*3+1]:=(i-32)*63 div 23;
  2921. End;
  2922. For i:=56 to 79 do Begin {Farbe 56-79: Anstieg Blau,Rot u. Blau konst.}
  2923. Palette[i*3]:=63;
  2924. Palette[i*3+1]:=63;
  2925. Palette[i*3+2]:=(i-56)*63 div 23;
  2926. End;
  2927. FillChar(Palette[80*3],176*3,63); {Rest weiá}
  2928. SetPal; {fertige Palette setzen}
  2929. End;
  2930.  
  2931. begin
  2932. Randomize; {Random Seed bestimmen}
  2933. GetMem(Src_Frame,320*100); {Speicher fr Quellbild holen und l”schen}
  2934. FillChar(Src_Frame^,320*100,0);
  2935. GetMem(Dest_Frame,320*100); {Speicher fr Ziellbild holen und l”schen}
  2936. FillChar(Dest_Frame^,320*100,0);
  2937. Init_Mode13; {Mode 13h setzen}
  2938. Prep_Pal; {Palette vorbereiten}
  2939. Repeat
  2940. Scroll_Up; {Flammen nach oben}
  2941. New_Line; {unten neue Linie anfgen}
  2942. Show_Screen; {fertigen Bildschirm zeigen}
  2943. Until KeyPressed;
  2944. TextMode(3);
  2945. end.
  2946. Uses Crt,Gif,ModeXLib;
  2947. Procedure Fliess;
  2948. var i,
  2949. Old9:Byte;
  2950. Begin
  2951. Port[$3d4]:=9; {CRTC Register 9 (Maximum Row Adress) selekt.}
  2952. Old9:=Port[$3d5] and $80; {alten Inhalt speichern, }
  2953. for i:=2 to 31 do begin {erspart st„ndiges auslesen}
  2954. WaitRetrace; {Synchronisation}
  2955. Port[$3d5]:=old9 or i; {Wert schreiben}
  2956. End;
  2957. End;
  2958.  
  2959. Begin
  2960. asm mov ax,13h; int 10h End; {Mode 13h ein (oder anderer Grafikmodus)}
  2961. LoadGif('beule'); {Hintergrund-Bild laden}
  2962. Move(vscreen^,Ptr($a000,0)^,64000); {und auf Screen}
  2963. ReadLn;
  2964. Fliess; {Wegflieáen ausl”sen}
  2965. ReadLn;
  2966. TextMode(3); {VGA wieder in Ursprungszustand setzen}
  2967. End.
  2968. Unit Font;
  2969.  
  2970. Interface
  2971.  
  2972. Procedure Print_Char(Chr:Char);
  2973. {gibt Zeichen auf Mode X aus}
  2974. Procedure Print_String(Str:String);
  2975. {gibt String auf Mode X aus}
  2976.  
  2977. Procedure Scrl_Move;
  2978. {bewegt sichtbaren Teil des Scrolly nach links}
  2979. Procedure Scrl_Append;
  2980. {h„ngt am rechten Bildrand neue Daten an Scrolly an}
  2981.  
  2982. Var Scrl_Y:Word; {vertikale Position des Scrollys}
  2983.  
  2984. Const
  2985. Scrl_Anzahl=4;
  2986. {Anzahl der in Scrl_Txt vorhandenen Strings}
  2987. Scrl_Txt:Array [1..Scrl_Anzahl] of String =
  2988. {Nur ein Demo-Text, der beliebig ver„ndert oder erg„nzt werden kann !}
  2989. ('Hallo, !!!dies ist ein Demo-Scroller aus dem Buch P C U N D E R G R O U N D'
  2990. +' von Data Becker. Zugegeben, es ist nicht gerade der anspruchsvollste, ',
  2991. 'dafuer kommt er aber mit einem Minimum an Aufwand und vor allem '
  2992. +'Rechenzeit aus. Selbst auf langsameren Rechnern ist es ohne weiteres ',
  2993. 'moeglich, nebenbei ganz andere Effekte zu benutzen; jedenfalls benoetigt '
  2994. +'der Scroller auf einem 486-40 mit ausgeschaltetem Turbo nur etwa ',
  2995. '10 Prozent der verfuegbaren Rechenzeit Achtung Scrolly startet '
  2996. +'jetzt neu --------------------------- ');
  2997.  
  2998.  
  2999. Implementation
  3000. Uses ModeXLib;
  3001. Const
  3002. CharPos:Array[' '..'Z', 0..1] of Word=
  3003. {Positionen und Breiten der einzelnen Zeichen,
  3004. jeweils CPU-adressierte Bytes}
  3005. ((71,4),(0,0),(0,0),(0,0),(0,0),(0,0),
  3006. (0,0),(0,0),(0,0),(0,0),(0,0),(0,0),
  3007. (1906,3),(1909,3),(1912,3),(1915,4), {,-./}
  3008. (3600,5),(3605,3),(3608,5),(3613,5), {0..3}
  3009. (3618,5),(3623,5),(3628,5),(3633,5), {4..7}
  3010. (3638,5),(3643,5),(3648,3),(3651,3), {8..;}
  3011. (3654,5),(3659,5),(3664,5),(3669,4), {<..?}
  3012. (0,0),(0,5),(5,5),(10,5),(15,6),(21,5), {@..E}
  3013. (26,4),(30,7),(37,5),(42,3),(45,4),(49,5),{F..K}
  3014. (54,4),(58,8),(66,5),(1840,7),(1847,5), {L..P}
  3015. (1852,7),(1859,5),(1864,4),(1868,4), {Q..T}
  3016. (1872,5),(1877,6),(1883,8),(1891,5), {U..X}
  3017. (1896,5),(1901,5)); {YZ}
  3018.  
  3019. Var Cur_X, {gegenw„rtige x-}
  3020. Cur_Y:Integer; {und y-Position des Cursors}
  3021.  
  3022. Scrl_Number, {Nummer des gerade aktiven Scroll-Strings}
  3023. Scrl_Pos, {Position innerhalb dieses Strings}
  3024. Scrl_ChrPos:Word; {Position innerhalb des Zeichens}
  3025.  
  3026. Procedure Print_Char(Chr:Char);
  3027. {Gibt ein Zeichen auf Mode X Bildschirm aus und bewegt Cursor
  3028. eine Position weiter}
  3029. Begin
  3030. Chr:=UpCase(Chr); {nur Groábuchstaben verwenden}
  3031. If Chr in [' '..'Z'] Then Begin {ist das Zeichen im Zeichensatz ?, ja:}
  3032. If 80- Cur_X < {noch genug Platz ?}
  3033. CharPos[Chr,1] Then Begin
  3034. Cur_X:=0; {nein, dann n„chste Zeile, x auf 0}
  3035. Inc(Cur_Y,25); {und y eine Zeichenh”he weiter}
  3036. End;
  3037. Copy_Block(Cur_Y*80+Cur_X, 48000+Charpos[Chr,0], CharPos[Chr,1], 22);
  3038. {Zeichen von Font-Position (aus CharPos-Tabelle) an Cursorposition
  3039. (Cur_Y * 80 Byte pro Zeile + Cur_X) kopieren (H”he 22 Zeilen}
  3040. Inc(Cur_X,CharPos[Chr,1]); {Cursor um Zeichenbreite bewegen}
  3041. End;
  3042. End;
  3043.  
  3044. Procedure Print_String(Str:String);
  3045. {gibt einen String auf Mode X Bildschirm aus,
  3046. benutzt dazu Print_Char}
  3047. Var i:Word;
  3048. Begin
  3049. For i:=1 to Length(Str) do {gesamten String an Print_Char schicken}
  3050. Print_Char(Str[i]);
  3051. End;
  3052.  
  3053. Procedure Scrl_Move;
  3054. {verschiebt einfach Bildinhalt an der Stelle des Scrollys um eine
  3055. Position nach links, also 79 Bytes von x-Position 1 nach x-Position 0
  3056. kopieren}
  3057. Begin
  3058. Copy_Block(Scrl_y*80, Scrl_Y*80 +1, 79,22);
  3059. End;
  3060.  
  3061. Procedure Scrl_Append;
  3062. Var Chr:Char; {aktueller Buchstabe}
  3063. Begin
  3064. Chr:=UpCase(Scrl_txt[Scrl_Number,Scrl_pos]);
  3065. {Buchstaben holen, nur Groábuchstaben}
  3066. If Chr in [' '..'Z'] Then Begin {ist das Zeichen im Zeichensatz ?, ja:}
  3067. If CharPos[Chr,1] > 0 Then {nur vorhandene Zeichen darstellen}
  3068. Copy_Block(Scrl_y*80+79, 48000+CharPos[Chr,0]+Scrl_ChrPos, 1, 22);
  3069. {dann 1 Spalte aus Zeichensatz an rechten}
  3070. {Bildschirmrand kopieren}
  3071. Inc(Scrl_ChrPos); {und n„chste Spalte innerhalb des Zeichens}
  3072. If Scrl_ChrPos >= CharPos[Chr,1] Then Begin
  3073. Inc(Scrl_Pos); {wenn Zeichen fertig, n„chstes Zeichen}
  3074. Scrl_ChrPos:=0; {und Spalte wieder auf 0}
  3075. If Scrl_Pos > Length(Scrl_Txt[Scrl_Number]) Then Begin
  3076. Inc(Scrl_Number); {wenn String fertig, n„chsten String}
  3077. Scrl_Pos:=1; {Position wieder auf 0}
  3078. If Scrl_Number > Scrl_Anzahl Then Begin
  3079. Scrl_Number:=1; {wenn Text fertig, wieder von vorn}
  3080. Scrl_Pos:=1;
  3081. Scrl_ChrPos:=0;
  3082. End;
  3083. End;
  3084. End;
  3085. End;
  3086. End;
  3087.  
  3088. Begin
  3089. Cur_X:=0; {Cursor auf linke obere Ecke}
  3090. Cur_Y:=0;
  3091.  
  3092. Scrl_Y:=50; {Default-Wert fr y-Position}
  3093. Scrl_Number:=1; {Start mit String 1, Zeichen 1, Spalte 0}
  3094. Scrl_Pos:=1;
  3095. Scrl_ChrPos:=0;
  3096. End.
  3097. unit gif; {Header zu gif.asm}
  3098.  
  3099. Interface
  3100. uses modexlib; {wg. SetPal}
  3101. var
  3102. vram_pos, {aktuelle Position im VGA-Ram}
  3103. rest, errornr:word; {restliche Bytes im Hauptspeicher und Fehler}
  3104.  
  3105. gifname:String; {Name, erweitert um #0}
  3106. Procedure LoadGif(GName:String);
  3107. {L„dt Gif-Datei "GName.gif" in vscreen}
  3108. Procedure LoadGif_Pos(GName:String;Posit:Word);
  3109. {L„dt Gif-Datei an Bildschirmoffset Posit}
  3110.  
  3111. Implementation
  3112. Procedure ReadGif;external; {eigentlicher Gif-Loader, kompl. in Asm}
  3113. {$l gif}
  3114.  
  3115. Procedure LoadGif;
  3116. {L„dt Gif-Datei "GName.gif" in vscreen}
  3117. Begin
  3118. If pos('.',gname) = 0 then {evtl. Endung ".gif" anh„ngen}
  3119. gname:=gname+'.gif';
  3120. Gifname:=GName+#0;; {ASCIIZ - String erzeugen}
  3121. vram_pos:=0; {im VGA-Ram an Offset 0 beginnen}
  3122. ReadGif; {und Bild laden}
  3123. If Errornr <> 0 Then {bei Fehler abbrechen}
  3124. Halt(Errornr);
  3125. SetPal; {geladene Palette setzen}
  3126. End;
  3127.  
  3128. Procedure LoadGif_pos;
  3129. {L„dt Gif-Datei an Bildschirmoffset Posit}
  3130. Begin
  3131. If pos('.',gname) = 0 then {evtl. Endung ".gif" anh„ngen}
  3132. gname:=gname+'.gif';
  3133. Gifname:=GName+#0; {ASCIIZ - String erzeugen}
  3134. vram_pos:=posit; {im VGA-Ram an bergebenen Offset beginnen}
  3135. ReadGif; {und Bild laden}
  3136. If Errornr <> 0 Then {bei Fehler abbrechen}
  3137. Halt(Errornr);
  3138. SetPal; {geladene Palette setzen}
  3139. End;
  3140. Begin
  3141. errornr:=0; {normalerweise kein Fehler}
  3142. GetMem(VScreen,64000); {virtuellen Bildschirm allokieren}
  3143. End.
  3144. {$G+}
  3145. {$m 1024,0,0} {wenig Stack und kein Heap ben”tigt}
  3146. Uses ModeXLib,Crt,Dos;
  3147.  
  3148. Var OldInt9:Pointer; {Zeiger auf alten Tastaturhandler}
  3149. active:Boolean; {gesetzt, wenn bereits Hardcopy im Gange}
  3150. nr:Word; {Nummer des Bilds, zur Vergabe von Filenamen}
  3151. installiert:Boolean; {bereits installiert ?}
  3152.  
  3153. Mode, {aktueller VGA-Mode: 13h, ffh (Mode X)}
  3154. {oder 0 (keiner der beiden}
  3155. Split_at, {Split-Line (Grafikzeile}
  3156. LSA, {Linear Starting Address}
  3157. Skip:Word; {Anzahl zu berspringender Bytes}
  3158.  
  3159. Procedure GetMode;
  3160. {bestimmt aktuellen Grafikmodus 13h oder Mode X (Nr. 255)}
  3161. {und Rahmendaten (Split-Line, Startadresse)}
  3162. Begin
  3163. Mode:=$13; {Mode 13h Standard}
  3164. asm {Bios-Mode bestimmen}
  3165. mov ax,0f00h {Funktion: Video-Info}
  3166. int 10h
  3167. cmp al,13h {Bios-Mode 13h gesetzt ?}
  3168. je @Bios_ok
  3169. mov mode,0 {wenn nein -> weder Mode 13h noch X aktiv}
  3170. @bios_ok:
  3171. End;
  3172. If Mode=0 Then Exit; {falscher Modus -> abbrechen}
  3173.  
  3174. Port[$3c4]:=4; {TS-Register 4 (Memory Mode) auslesen}
  3175. If Port[$3c5] and 8 = 0 Then {Chain 4 (Bit 3) inaktiv ?}
  3176. Mode:=$ff; {dann Mode X}
  3177.  
  3178. Port[$3d4]:=$0d; {Linear Starting Address Low (CRTC 0dh)}
  3179. LSA:=Port[$3d5]; {auslesen}
  3180. Port[$3d4]:=$0c; {Linear Starting Address High (CRTC 0ch)}
  3181. LSA:=LSA or Port[$3d5] shl 8; {auslesen und eintragen}
  3182.  
  3183. Port[$3d4]:=$18; {Line Compare CRTC 18h}
  3184. Split_at:=Port[$3d5]; {auslesen}
  3185. Port[$3d4]:=7; {Overflow Low}
  3186. Split_at:=Split_at or {Bit 4 ausmaskieren und nach Bit 8 schieben}
  3187. (Port[$3d5] and 16) shl 4;
  3188. Port[$3d4]:=9; {Maximum Row Address}
  3189. Split_at:=Split_at or {Bit 6 ausmaskieren unf nach Bit 9 schieben}
  3190. (Port[$3d5] and 64) shl 3;
  3191. Split_at:=Split_at shr 1; {auf Bildschirmzeilen umrechnen}
  3192.  
  3193. Port[$3d4]:=$13; {Row Offset (CRTC Register 13h)}
  3194. Skip:=Port[$3d5]; {auslesen}
  3195. Skip:=Skip*2-80 {Differenz zum "normalen" Zeilenabstand lesen}
  3196. End;
  3197.  
  3198.  
  3199. Procedure PCXShift;assembler;
  3200. {bereitet aktuelle Palette auf PCX vor (2 nach links shiften)}
  3201. asm
  3202. mov si,offset palette {Zeiger auf Palette in ds:si}
  3203. mov cx,768 {768 Bytes bearbeiten}
  3204. @lp:
  3205. lodsb {Wert holen}
  3206. shl al,2 {shiften}
  3207. mov ds:[si-1],al {zurckschreiben an alte Position}
  3208. loop @lp {und Schleife abschlieáen}
  3209. End;
  3210.  
  3211. Var pcx:File; {PCX-Datei auf Platte}
  3212.  
  3213. Procedure Hardcopy(Startadr,splt:Word;s : string);
  3214. {kopiert Grafik 320x200 (Mode 13 o. X) als PCX in Datei s}
  3215. {aktueller Bildschirmstart (Linear Starting Address) in Startadr}
  3216. {Split-Zeile in splt}
  3217. Var Buf:Array[0..57] of Byte; {nimmt Daten vor Speichern auf}
  3218. Aux_Ofs:Word;
  3219. const
  3220. Header1:Array[0..15] of Byte {PCX-Kopf, erster Teil}
  3221. =($0a,5,1,8, 0,0, 0,0, $3f,1, 199,0,$40,1,200,0);
  3222. Header2:Array[0..5] of Byte {PCX-Kopf, erster Teil}
  3223. =(0,1,$40,1,0,0);
  3224. plane:Byte=0; {aktuelle Planenr}
  3225.  
  3226. var count:Byte; {Anzahl gleicher Zeichen}
  3227. wert, {gerade geholter Wert}
  3228. lastbyt:Byte; {vorheriger Wert}
  3229. i:word; {Byte-Z„hler}
  3230.  
  3231. begin
  3232. asm {Palette auslesen}
  3233. xor al,al {bei Farbe 0 beginnen}
  3234. mov dx,3c7h {dies dem DAC ber Pixel Read Address}
  3235. out dx,al {mitteilen}
  3236.  
  3237. push ds {Zeiger es:di auf Palette}
  3238. pop es
  3239. mov di,offset palette
  3240. mov cx,768 {768 Bytes auslesen}
  3241. mov dx,3c9h {Pixel Color Value}
  3242. rep insb {und lesen}
  3243.  
  3244. cmp mode,13h {Mode X ?}
  3245. je @Linear {dann:}
  3246. mov dx,03ceh {Schreib- und Lesemodus 0 setzen}
  3247. mov ax,4005h {ber GDC-Register 5 (GDC Mode)}
  3248. out dx,ax
  3249. @Linear:
  3250. End;
  3251.  
  3252. Assign(pcx,s); {Datei zum Schreiben ”ffnen}
  3253. Rewrite(pcx,1);
  3254.  
  3255. BlockWrite(pcx,Header1,16); {Header Teil 1 schreiben}
  3256. PCXShift; {Palette vorbereiten}
  3257. BlockWrite(pcx,palette,48); {ersten 16 Farben eintragen}
  3258. BlockWrite(pcx,Header2,6); {Header Teil 1 schreiben}
  3259. FillChar(buf,58,0); {58 Nullen schreiben (Header fllen)}
  3260. BlockWrite(pcx,buf,58);
  3261. plane:=0; {mit Plane 0 beginnen}
  3262. count:=1; {Anzahl mit 1 initialisieren}
  3263. If splt<200 Then
  3264. If Mode = $ff Then
  3265. splt:=splt*80 Else {Split-Offset berechnen}
  3266. splt:=splt*320 Else {je nach Mode unterschiedlich}
  3267. Splt:=$ffff;
  3268. If Mode=$13 Then {LSA bezieht sich auf das Plane-Modell !}
  3269. Startadr:=Startadr*4;
  3270. for i:=0 to 64000 do Begin {jeden Punkt bearbeiten}
  3271. If i shr 2 < splt Then
  3272. aux_ofs:=(i div 320) * skip {Hilfsoffset unter Bercksichtigung}
  3273. {der Zeilenbreite setzen}
  3274. Else
  3275. aux_ofs:=((i shr 2 - splt) div 320) * skip;
  3276. {bei Splitting Bezug auf VGA-Start}
  3277. asm {Punkt auslesen}
  3278. mov ax,0a000h {Segment laden}
  3279. mov es,ax
  3280. mov si,i {Offset laden}
  3281. cmp mode,13h {Mode 13h ?}
  3282. je @Linear1
  3283. shr si,2 {nein, dann Offset berechnen}
  3284. @Linear1:
  3285. cmp si,splt {Split-Line erreicht ?}
  3286. jb @weiter {nein, dann weiter}
  3287. sub si,splt {ansonsten alles weitere auf den}
  3288. sub si,startadr {Bildschirmstart beziehen}
  3289. @weiter:
  3290. add si,startadr {Startadresse drauf}
  3291. add si,aux_ofs {Hilfs-Offset addieren}
  3292.  
  3293. cmp mode,13h {Mode 13h ?}
  3294. je @Linear2 {nein, dann Mode X Lesemethode}
  3295. mov dx,03ceh {ber GDC-Register 4 (Read Plane Select)}
  3296. mov ah,plane {aktuelle Plane selektieren}
  3297. inc plane {und weiterschalten}
  3298. mov al,4
  3299. and ah,03h
  3300. out dx,ax
  3301. @Linear2:
  3302. mov al,es:[si] {Byte auslesen}
  3303. mov wert,al {und in Variable Wert sichern}
  3304. End;
  3305. If i<>0 Then Begin {beim ersten Byte keine Kompression}
  3306. If (Wert = lastbyt) Then Begin{gleiche Bytes ?}
  3307. Inc(Count); {dann Z„hler erh”hen}
  3308. If (Count=64) or {Z„hler schon zu hoch ?}
  3309. (i mod 320 =0) Then Begin {oder Zeilenanfang ?}
  3310. buf[0]:=$c0 or (count-1); {dann Zwischenspeichern}
  3311. buf[1]:=lastbyt; {Z„hlerstand und Wert schreiben}
  3312. count:=1; {Z„hler reinitialisieren}
  3313. BlockWrite(pcx,buf,2); {und auf die Platte damit}
  3314. End;
  3315. End Else {verschiedene Bytes :}
  3316. If (Count > 1) or {waren es mehrere gleiche ?}
  3317. (lastbyt and $c0 <> 0) Then {Wert zu groá zum direkten Schreiben ?}
  3318. Begin
  3319. buf[0]:=$c0 or count; {dann Anzahl und Wert in Datei schreiben}
  3320. buf[1]:=lastbyt;
  3321. lastbyt:=Wert; {aktuellen Wert fr weitere Kompression}
  3322. Count:=1; {sichern und reinitialisieren}
  3323. BlockWrite(pcx,buf,2);
  3324. End Else Begin {einzelnes, legales Byte:}
  3325. buf[0]:=lastbyt; {direkt schreiben}
  3326. lastbyt:=Wert; {aktuellen Wert fr sp„ter sichern}
  3327. BlockWrite(pcx,buf,1);
  3328. End;
  3329.  
  3330. End Else lastbyt:=wert; {beim ersten Byte nur sichern}
  3331. End;
  3332. buf[0]:=$0c; {Kennung Palette einfgen}
  3333. blockwrite(pcx,buf[0],1); {und schreiben}
  3334. blockwrite(pcx,palette,256*3);{und Palette anfgen}
  3335. Close(pcx); {Datei schlieáen}
  3336. End;
  3337.  
  3338.  
  3339. Procedure Action;
  3340. {wird bei Aktivierung des Hot-Keys aufgerufen}
  3341. Var nrs:String; {String zur Namensvergabe}
  3342. Begin
  3343. if not active Then Begin {nur wenn nicht bereits aktiv}
  3344. active:=true; {als aktiv vermerken}
  3345. str(nr,nrs); {Nummer in String umwandeln und erh”hen}
  3346. Inc(nr);
  3347. GetMode; {Grafikmodus etc. ermitteln}
  3348. If Mode <> 0 Then
  3349. HardCopy(LSA,Split_at,'hard'+nrs+'.pcx');
  3350. {Hardcopy durchfhren}
  3351. active:=false; {erneute Aktivierung freigeben}
  3352. End;
  3353. End;
  3354.  
  3355. Procedure Handler9;interrupt;assembler;
  3356. {neuer Interrupt-Handler fr Tastatur-IRQ}
  3357. asm
  3358. pushf
  3359. call [oldint9] {alten IRQ 1 - Handler aufrufen}
  3360.  
  3361. cli {keine weiteren Interrupts}
  3362. in al,60h {Scancode lesen}
  3363. cmp al,34d {G ?}
  3364. jne @fertig {nein -> Handler beenden}
  3365. xor ax,ax {0-Segment laden}
  3366. mov es,ax
  3367. mov al,es:[417h] {Keyboard-Status lesen}
  3368. test al,8 {Bit 8 (Alt-Taste) gesetzt ?}
  3369. je @fertig {nein -> Handler beenden}
  3370.  
  3371. call action {Hardcopy durchfhren}
  3372. @fertig:
  3373. sti {Interrupts wieder zulassen}
  3374. End;
  3375.  
  3376. Procedure kennung;assembler;
  3377. {Dummy-Prozedur, enth„lt Copyrightmeldung fr Installationskennung}
  3378. {KEIN AUSFšHRBARER CODE !}
  3379. asm
  3380. db 'Screen-Grabber, (c) Data Becker 1994';
  3381. End;
  3382.  
  3383. Procedure Check_Inst;assembler;
  3384. {berprft, ob Grabber bereits installiert}
  3385. asm
  3386. mov installiert,1 {Annahme: bereits installiert}
  3387. push ds {ds wird noch ben”tigt !}
  3388. les di,oldint9 {Zeiger auf alten Handler laden}
  3389. mov di,offset kennung {im gleichen Segment auch Prozedur Kennung}
  3390. mov ax,cs {ds:si auf Kennung dieses Programms setzen}
  3391. mov ds,ax
  3392. mov si,offset kennung
  3393. mov cx,20 {20 Zeichen vergleichen}
  3394. repe cmpsb
  3395. pop ds {ds wieder herstellen}
  3396. jcxz @installiert {gleich, dann bereits installiert}
  3397. mov installiert,0 {nicht installiert: merken}
  3398. @installiert:
  3399. End;
  3400.  
  3401. Begin
  3402. nr:=0; {erster Dateiname: hard0.pcx}
  3403. GetIntVec(9,OldInt9); {alten Interrupt-Vektor holen}
  3404. Check_Inst; {prfen, ob schon installiert}
  3405. If not installiert Then Begin {wenn nein:}
  3406. SetIntVec(9,@Handler9); {neuen Handler installieren}
  3407. WriteLn('Grabber installiert');
  3408. WriteLn('(c) Data Becker 1994');
  3409. WriteLn('Aktivierung mit <alt> g');
  3410. Keep(0); {Meldung ausgeben und resident beenden}
  3411. End;
  3412. WriteLn('Grabber bereits installiert');
  3413. {wenn schon installiert, Meldung und beenden}
  3414. End.
  3415. Uses Crt;
  3416.  
  3417. Var x:Word;
  3418.  
  3419. Procedure PutPixel(x,y,col:word);assembler;
  3420. {setzt Punkt (x/y) auf Farbe col (Mode 13h)}
  3421. asm
  3422. mov ax,0a000h {Segment laden}
  3423. mov es,ax
  3424. mov ax,320 {Offset = Y*320 + X}
  3425. mul y
  3426. add ax,x
  3427. mov di,ax {Offset laden}
  3428. mov al,byte ptr col {Farbe laden}
  3429. mov es:[di],al {und Punkt setzen}
  3430. End;
  3431.  
  3432. Procedure Line(x1,y1,x2,y2,col:Word);assembler;
  3433. asm
  3434. {verwendete Register:
  3435. bx/cx: Vor-/Nachkommateil der y-Koordinate
  3436. si : Nachkommateil der Steigung}
  3437. mov si,x1 {x mit Startwert laden}
  3438. mov x,si
  3439. sub si,x2 {und x-Differenz bilden (in si)}
  3440.  
  3441. mov ax,y1 {y (gespeichert in bx) mit Startwert laden}
  3442. mov bx,ax
  3443. sub ax,y2 {und y-Differenz bilden (in ax)}
  3444.  
  3445. mov cx,100 {y-Differenz wg Rechengenauigkeit erweitern}
  3446. imul cx
  3447. idiv si {und durch x-Diff dividieren (Steigung)}
  3448. mov si,ax {Steigung in si sichern}
  3449.  
  3450. xor cx,cx {Nachkommateil der y-Koordinate auf 0}
  3451.  
  3452. @lp:
  3453. push x {x und Vorkommateil von y an PutPixel}
  3454. push bx
  3455. push col
  3456. call PutPixel
  3457.  
  3458. add cx,si {y-Nachkommateil erh”hen}
  3459. cmp cx,100 {Nachkomma-šberlauf ?}
  3460. jb @kein_ueberlauf {nein, dann weiter}
  3461. sub cx,100 {ansonsten Nachkommateil verringern}
  3462. inc bx {und Vorkommateil erh”hen}
  3463.  
  3464. @kein_ueberlauf:
  3465. inc x {auch x weiterz„hlen}
  3466. mov ax,x
  3467. cmp ax,x2 {Ende erreicht ?}
  3468. jb @lp {nein, dann n„chsten Durchlauf}
  3469. end;
  3470.  
  3471. Begin
  3472. asm mov ax,0013h; int 10h end;{Mode 13h einschalten}
  3473. Line(10,10,100,50,1); {Linie ziehen}
  3474. ReadLn;
  3475. Textmode(3);
  3476. End.{$N-} {Coprozessor aus}
  3477. Uses Crt,Tools;
  3478.  
  3479. Var phi, {Winkel}
  3480. x,y:Word; {Koordinaten}
  3481. Zeichen:Byte; {benutztes Zeichen}
  3482. Sinus:Array[1..360] of Word;{nimmt die Sinus-Tabelle auf}
  3483.  
  3484. Procedure Sinus_Real; {zeichnet 26 mal einen Kreis}
  3485. Begin
  3486. For Zeichen:=Ord('A') to Ord('Z')do {26 Durchl„ufe}
  3487. For phi:=1 to 360 do Begin
  3488. x:=Trunc(Round(Sin(phi/180*pi)*20+40)); {x-Koordinate berechnen}
  3489. y:=Trunc(Round(Cos(phi/180*pi)*10+12)); {y-Koordinate berechnen}
  3490. mem[$b800:y*160+x*2]:=Zeichen; {Zeichen auf den Bildschirm}
  3491. End;
  3492. End;
  3493. Procedure Sinus_neu; {zeichnet 26 mal einen Kreis}
  3494. Begin
  3495. For Zeichen:=Ord('A') to Ord('Z')do {26 Durchl„ufe}
  3496. For phi:=1 to 360 do Begin
  3497. x:=Sinus[phi]+40; {x-Koordinate berechnen}
  3498. If phi<=270 Then {y-Koordinate berechnen}
  3499. y:=Sinus[phi+90] div 2 + 12 Else {Kosinus als verschobenen Sinus}
  3500. y:=Sinus[phi-270] div 2 + 12;
  3501. mem[$b800:y*160+x*2]:=Zeichen; {Zeichen auf den Bildschirm}
  3502. End;
  3503. End;
  3504.  
  3505. Begin
  3506. Sin_Gen(Sinus,360,20,0); {Sinus-Tabelle vorbereiten}
  3507. ClrScr; {Bildschirm l”schen}
  3508. Sinus_real; {Kreise zeichnen}
  3509. ClrScr; {Bildschirm l”schen}
  3510. Sinus_neu; {Kreise zeichnen}
  3511. End.
  3512. unit modexlib; {Header fr modexlib.asm}
  3513. Interface
  3514. Var
  3515. Vscreen:Pointer; {Zeiger auf Quellbereich fr p13_2_modex}
  3516. vpage:Word; {Offset der aktuell unsichtbaren Seite}
  3517. palette:Array[0..256*3-1] of Byte; {VGA - Palette}
  3518.  
  3519. Procedure Init_ModeX; {ModeX einschalten}
  3520. Procedure Enter400; {von Mode X nach 400-Zeilen schalten}
  3521. Procedure Double; {virtuelle horiz. Aufl”sung von 640 ein}
  3522.  
  3523. Procedure P13_2_ModeX(start,pic_size:word); {Bild auf Mode X - Screen kop.}
  3524. Procedure CopyScreen(Ziel,Quelle:Word); {Quell-Seite nach Ziel-Seite kop.}
  3525. Procedure Copy_Block(Ziel,Quelle,Breite,Hoehe:Word);
  3526. {kopiert Block von Quell-Offset nach Ziel}
  3527. Procedure ClrX(pmask:byte); {Mode X - Bildschirm l”schen}
  3528.  
  3529. Procedure Split(Row:Byte); {Screen-Splitting in Zeile Row}
  3530. Procedure Squeeze; {Bild zusammenfahren von oben und unten}
  3531. Procedure SetStart(t:Word); {Startadresse des sichtbaren Bilds setzen}
  3532. Procedure Switch; {zwischen Seite 0 und 1 hin und herschalten}
  3533.  
  3534. Procedure WaitRetrace; {wartet auf Vertikal-Retrace}
  3535. Procedure SetPal; {kopiert Palette in VGA-DAC}
  3536. Procedure GetPal; {liest Palette aus VGA-DAC aus}
  3537.  
  3538. Procedure Fade_Out; {blendet Bild aus}
  3539. Procedure Fade_To(Zielpal:Array of Byte; Schritt:Byte);
  3540. {blendet von Palette nach Zielpal}
  3541. Procedure Pal_Rot(Start,Ziel:Word);
  3542. {Rotiert Palettenteil um 1,
  3543. wenn Start>Ziel nach oben, sonst unten}
  3544.  
  3545.  
  3546. {interne Prozeduren:}
  3547. Procedure Screen_Off; {schaltet Bildschirm aus}
  3548. Procedure Screen_On; {schaltet Bildschirm wieder ein}
  3549. Procedure CRTC_Unprotect; {erm”glicht Zugriff auf Horizontal-Timing}
  3550. Procedure CRTC_Protect; {verbietet Zugriff wieder}
  3551.  
  3552. Procedure Init_Mode13; {schaltet Mode 13h ein}
  3553. Procedure Show_Pic13; {Kopiert VScreen auf Mode 13h}
  3554.  
  3555. Procedure Make_bw(Var WorkPal:Array of Byte); {Palette auf schwarz/weiá}
  3556.  
  3557. Implementation
  3558. Procedure Init_ModeX;external;
  3559. Procedure Enter400;external;
  3560. Procedure Double;external;
  3561.  
  3562. Procedure P13_2_ModeX;external;
  3563. Procedure CopyScreen;external;
  3564. Procedure Copy_Block;external;
  3565. Procedure ClrX;external;
  3566.  
  3567. Procedure Split;external;
  3568. Procedure Squeeze;external;
  3569. Procedure SetStart;external;
  3570. Procedure Switch;external;
  3571.  
  3572. Procedure WaitRetrace;external;
  3573. Procedure SetPal;external;
  3574. Procedure GetPal;external;
  3575.  
  3576. Procedure Fade_Out;external;
  3577. Procedure Fade_To;external;
  3578. Procedure Pal_Rot;external;
  3579. {$l modexlib}
  3580.  
  3581. Procedure Screen_Off;
  3582. Begin
  3583. Port[$3c4]:=1; {Register 1 des TS (TS Mode) selektieren}
  3584. Port[$3c5]:=Port[$3c5] or 32; {Bit 5 (Screen Off) setzen}
  3585. End;
  3586. Procedure Screen_On;
  3587. Begin
  3588. Port[$3c4]:=1; {Register 1 des TS (TS Mode) selektieren}
  3589. Port[$3c5]:=Port[$3c5] and not 32; {Bit 5 (Screen Off l”schen}
  3590. End;
  3591. Procedure CRTC_UnProtect;
  3592. Begin
  3593. Port[$3d4]:=$11; {Register 11h des CRTC (Vertical Sync End)}
  3594. Port[$3d5]:=Port[$3d5] and not $80 {Bit 7 (Protection Bit) l”schen}
  3595. End;
  3596. Procedure CRTC_Protect;
  3597. Begin
  3598. Port[$3d4]:=$11; {Register 11h des CRTC (Vertical Sync End)}
  3599. Port[$3d5]:=Port[$3d5] or $80 {Bit 7 (Protection Bit) setzen}
  3600. End;
  3601. Procedure Init_Mode13;assembler;
  3602. asm
  3603. mov ax,13h
  3604. int 10h
  3605. End;
  3606. Procedure Show_Pic13; {Kopiert VScreen auf Mode 13h}
  3607. Begin
  3608. Move(Vscreen^,Ptr($a000,0)^,64000);
  3609. End;
  3610. Procedure Make_bw; {Palette nach schwarz/weiá reduzieren}
  3611. Var i,sum:Word; {Wertung: 30% rot, 59% grn, 11% blau}
  3612. Begin
  3613. For i:=0 to 255 do Begin
  3614. Sum:=Round(WorkPal[i*3]*0.3 + WorkPal[i*3+1]*0.59 + WorkPal[i*3+2]*0.11);
  3615. FillChar(WorkPal[i*3],3,Sum); {Werte eintragen}
  3616. End;
  3617. End;
  3618.  
  3619. Begin
  3620. End.
  3621. Uses Crt,ModeXLib,Gif;
  3622.  
  3623. Var slow_flag:Boolean; {zu Steuerung der langsamen Verl„ufe}
  3624.  
  3625. Begin
  3626. Init_Mode13; {Mode 13h ein}
  3627. LoadGif('palrot'); {Bild laden und anzeigen}
  3628. Show_Pic13;
  3629. Repeat
  3630. Pal_Rot(16,47); {"Schachbrett" bewegen}
  3631. If slow_flag Then Begin {bei jedem 2. Durchlauf:}
  3632. Pal_Rot(63,48); {"Springbrunnen" bewegen}
  3633. Pal_Rot(88,64); {"Radar" bewegen}
  3634. End;
  3635. slow_flag:=not slow_flag; {abwechselnd "Springbrunnen" und "Radar"}
  3636. {erm”glichen und sperren}
  3637. WaitRetrace; {Synchronisation}
  3638.  
  3639. SetPal; {die rotierte Palette setzen}
  3640. Until KeyPressed; {bis Tastendruck}
  3641. TextMode(3);
  3642. End.
  3643. {$G+}
  3644. Uses Crt,Sprites,ModeXLib,Gif,Tools;
  3645.  
  3646.  
  3647. Procedure PutScalSprt(pg_ofs,x,y,scale_y:Integer;qsprite:spritetyp);
  3648. var planecount, {Z„hler der bereits kopierten Planes}
  3649. planemask:Byte; {maskiert Write-Plane in TS-Register 2}
  3650. Skip, {Anzahl zu berspringender Bytes}
  3651. ofs, {aktueller Offset im Bildschirmspeicher}
  3652. plane, {Nummer der aktuellen Plane}
  3653. Breite, {Breite zu kopierender Bytes in einer Zeile,}
  3654. dty:Word; {H”he}
  3655. quelle:Pointer; {Zeiger auf Grafikdaten, wenn ds ver„ndert}
  3656.  
  3657. ppp:Array[0..3] of Byte; {Anzahl Pixel pro Plane}
  3658. rel_y, {Nachkommateil der rel. y-Position}
  3659. add_y:Word; {Nachkommawert des Summanden}
  3660. direction:Integer; {Bewegungs-Richtung (+/- 80)}
  3661. i:Word; {lokaler Schleifenz„hler}
  3662. Begin
  3663. if (x + qsprite.dtx > 319) {Clipping ? dann Abbruch}
  3664. or (x < 0)
  3665. or (y + qsprite.dty*scale_y div 100 > 199) or (y < 0) then exit;
  3666. add_y:=100-abs(scale_y); {Summanden berechnen}
  3667. if scale_y < 0 then direction:=-80 else direction:=80;
  3668. {Richtung festlegen}
  3669. Quelle:=qsprite.adr; {Zeiger Grafik-Daten}
  3670. dty:=qsprite.dty; {lokale Hoehen-Variable laden}
  3671. plane:=x mod 4; {Start-Plane}
  3672. ofs:=pg_ofs+80*y+(x div 4); {und -Offset berechnen}
  3673. Breite:=0; {Breite und Skip vorinitialisieren}
  3674. Skip:=0;
  3675.  
  3676. i:=qsprite.dtx shr 2; {Anzahl glatter Viererbl”cke}
  3677. ppp[0]:=i;ppp[1]:=i; {entspricht Mindestanzahl zu kop. Bytes}
  3678. ppp[2]:=i;ppp[3]:=i;
  3679. For i:=1 to qsprite.dtx and 3 do{"berstehende" Pixel in ppp vermerken}
  3680. Inc(ppp[(plane+i - 1) and 3]);{beginnend mit Startplane Pixel anfgen}
  3681. asm
  3682. push ds {ds sichern}
  3683. mov ax,0a000h {Zielsegment (VGA) laden}
  3684. mov es,ax
  3685.  
  3686. lds si,quelle {Quelle (Zeiger auf Grafikdaten) nach ds:si}
  3687. mov cx,plane {Start-Planemaske erstellen}
  3688. mov ax,1 {dazu Bit 0 um Plane nach links schieben}
  3689. shl ax,cl
  3690. mov planemask,al {Maske sichern}
  3691. shl al,4 {auch in oberes Nibble eintragen}
  3692. or planemask,al
  3693. mov planecount,4 {4 Planes zu kopieren}
  3694. @lplane: {wird einmal pro Plane durchlaufen}
  3695. mov cl,byte ptr plane {aktuelle Plane laden}
  3696. mov di,cx {in di}
  3697. mov cl,byte ptr ppp[di] {cx mit zugeh”riger ppp-Anzahl laden}
  3698. mov byte ptr Breite,cl {Skip jeweils neu ausrechnen}
  3699. mov ax,direction {dazu Differenz Direction-Breite bilden}
  3700. sub ax,cx
  3701. mov skip,ax {und in skip schreiben}
  3702.  
  3703. mov rel_y,0 {Start wieder bei y=0,0}
  3704.  
  3705. mov cx,Breite {cx mit Breite laden}
  3706. or cl,cl {Breite 0, dann Plane fertig}
  3707. je @plane_fertig
  3708.  
  3709. mov di,ofs {Zieloffset im Bildschirmspeicher nach di}
  3710. mov ah,planemask {Planemaske auf bit [0..3] reduzieren}
  3711. and ah,0fh
  3712. mov al,02h {und ber TS - Register 2 (Write Plane Mask)}
  3713. mov dx,3c4h {setzen}
  3714. out dx,ax
  3715. mov bx,dty {y-Z„hler initialisieren}
  3716. @lcopy_y: {y-Schleife, pro Zeile einmal durchlaufen}
  3717. @lcopy_x: {x-Schleife, pro Punkt einmal durchlaufen}
  3718. lodsb {Byte holen}
  3719. or al,al {wenn 0, dann berspringen}
  3720. je @Wert0
  3721. stosb {ansonsten: setzen}
  3722. @entry:
  3723. loop @lcopy_x {und Schleife weiter}
  3724.  
  3725. mov ax,rel_y {Summanden auf Nachkommateil}
  3726. add ax,add_y
  3727. cmp ax,100 {Vorkommastelle erh”ht ?}
  3728. jb @noaddovfl {nein, dann weiter}
  3729. sub ax,100 {ansonsten Nachkommastelle zurcksetzen}
  3730. sub di,direction {und in n„chste/vorherige Zeile}
  3731. @noaddovfl:
  3732. mov rel_y,ax {und in Nachkommateil zurckschreiben}
  3733.  
  3734. dec bx {y-Z„hler weiter}
  3735. je @plane_fertig {y-Z„hler = 0, dann n„chste Plane}
  3736. add di,skip {sonst auf n„chsten Zeilenanfang springen}
  3737. mov cx,Breite {x-Z„hler reinitialisieren,}
  3738. jmp @lcopy_y {wieder in y-Schleife springen}
  3739. @wert0: {Sprite-Farbe 0:}
  3740. inc di {Zielbyte berspringen}
  3741. jmp @entry {und wieder in Schleife zurck}
  3742. @plane_fertig: {hier ist y-Schleife beendet}
  3743.  
  3744. rol planemask,1 {n„chste Plane maskieren}
  3745. mov cl,planemask {plane 0 selektiert ?}
  3746. and cx,1 {(Bit 1 gesetzt), dann}
  3747. add ofs,cx {Zieloffset erh”hen um 1 (Bit 1 !)}
  3748. inc plane {Plane-Nummer (Index in ppp) weiter}
  3749. and plane,3 {auf 0 bis 3 reduzieren}
  3750. dec planecount {schon 4 Planes kopiert ?, dann Ende}
  3751. jne @lplane
  3752. pop ds {ds restaurieren, und Tschá}
  3753. End;{asm}
  3754. End;
  3755.  
  3756. Var Logo:SpriteTyp;
  3757. Sinus:Array[0..99] of Word;
  3758. Hoehe:Integer;
  3759. i:Word;
  3760.  
  3761.  
  3762. Begin
  3763. Init_ModeX; {Mode X einschalten}
  3764. LoadGif('sprites'); {Bild mit Logo laden}
  3765. GetSprite(88+ 6*320,150,82,Logo); {Logo initialisieren}
  3766. LoadGif('phint'); {Hintergrundbild laden}
  3767. p13_2_ModeX(48000,16000); {und auf Hintergrundseite kopieren}
  3768. Sin_Gen(Sinus,100,100,0); {Sinus vorberechnen}
  3769. I:=0; {Index im Sinus auf 0}
  3770. repeat
  3771. Inc(i); {Index weiterz„hlen}
  3772. Hoehe:=Integer(Sinus[i mod 100]); {Hoehe aus Sinus holen}
  3773. CopyScreen(vpage,48000); {Hintergrund l”schen}
  3774. PutScalSprt(vpage,85,100-Hoehe *84 div 200,Hoehe,Logo);
  3775. {Sprite skaliert auf aktuelle Seite kopieren}
  3776. Switch; {auf diese Seite umschalten}
  3777. WaitRetrace; {und auf den Retrace warten}
  3778. Until KeyPressed;
  3779. ReadLn;
  3780. TextMode(3); {normalen Text-Mode ein}
  3781. End.
  3782. uses crt,Gif,ModeXLib;
  3783. Var x, {derzeitiger Offset in x-Richtung}
  3784. x_dir, {gibt Scroll Richtung fr x-an}
  3785. y, {derzeitiger Offset fr y-Richtung}
  3786. y_dir:word; {gibt Scroll Richtung fr y an}
  3787. split_line:word; {derzeitige Position der Split-Line}
  3788. split_dir:word; {gibt Bewegungsrichtung der Split-Line an}
  3789. Begin
  3790. Init_ModeX; {Mode X einschalten}
  3791. double; {160-Byte Modus einschalten}
  3792. Screen_Off; {Bildschirm aus}
  3793. LoadGif_Pos('640400',160*50);{groáes Bild an Position (0/50) laden}
  3794. p13_2_ModeX(vram_pos,rest div 4); {Rest in VGA-Speicher kopieren}
  3795. LoadGif('corner'); {kleines Bild an Position (0/0) laden}
  3796. p13_2_ModeX(0,160*50); {und auf Bildschirm kopieren}
  3797. Screen_On; {Bildschirm ein}
  3798.  
  3799. split_line:=150; {Split zun„chst auf Zeile 150 setzen}
  3800. split_dir:=1; {Split-Line zun„chst nach unten verschieben}
  3801. x:=1; {x-Beginn mit Spalte 1}
  3802. x_dir:=1; {x-Richtung 1 Byte pro Durchlauf}
  3803. y:=160; {y-Beginn mit Zeile 1}
  3804. y_dir:=160; {y-Richtung +160 Byte pro Durchlauf}
  3805. Repeat
  3806. Inc(x,x_dir); {x-Bewegung}
  3807. Inc(y,y_dir); {y-Bewegung}
  3808. Inc(Split_line,Split_dir); {Split Line bewegen}
  3809. WaitRetrace; {Auf Retrace warten}
  3810. SetStart(50*160+y+x); {und neuen Start in Register schreiben,}
  3811. {dabei ersten 50 Zeilen berspringen}
  3812. Split(Split_line); {Bildschirm an Split Line splitten}
  3813. if (x >= 80) {x-Rand erreicht -> x-Richtung umdrehen}
  3814. or (x <= 1) Then x_dir:=-x_dir;
  3815. if (y >= 200*160) {y-Rand erreicht -> y-Richtung umdrehen}
  3816. or (y <= 160) Then y_dir:=-y_dir;
  3817. if (split_line >= 200) {hat Split Rand erreicht -> Richtung wechseln}
  3818. or (split_line <= 150) then split_dir:=-split_dir
  3819. Until KeyPressed; {laufe, bis Taste gedrckt}
  3820. TextMode(3);
  3821. End.
  3822. Uses Crt,Gif,ModeXLib;
  3823. Var x, {derzeitiger Offset in x-Richtung}
  3824. x_dir, {gibt Scroll Richtung fr x-an}
  3825. y, {derzeitiger Offset fr y-Richtung}
  3826. y_dir:word; {gibt Scroll Richtung fr y an}
  3827. Begin
  3828. Init_ModeX; {Mode X einschalten}
  3829. double; {160-Byte Modus ein (640*400 Punkte gesamt}
  3830. LoadGif('640400'); {Bild laden}
  3831. p13_2_ModeX(vram_pos,rest div 4); {Rest des Bildes in Bildschirmspeicher}
  3832. x:=1; {x-Beginn mit Spalte 1}
  3833. x_dir:=1; {x-Richtung 1 Byte pro Durchlauf}
  3834. y:=160; {y-Beginn mit Zeile 1}
  3835. y_dir:=160; {y-Richtung +160 Byte pro Durchlauf}
  3836. Repeat
  3837. Inc(x,x_dir); {x-Bewegung}
  3838. Inc(y,y_dir); {y-Bewegung}
  3839. WaitRetrace; {Auf Retrace warten}
  3840. SetStart(y+x); {und neuen Start in Register schreiben}
  3841. if (x >= 80) {x-Rand erreicht -> x-Richtung umdrehen}
  3842. or (x <= 1) Then x_dir:=-x_dir;
  3843. if (y >= 200*160) {y-Rand erreicht -> y-Richtung umdrehen}
  3844. or (y <= 160) Then y_dir:=-y_dir;
  3845. Until KeyPressed; {laufe, bis Taste gedrckt}
  3846. TextMode(3);
  3847. End.
  3848. Uses ModeXLib,Crt;
  3849.  
  3850. Var x, {x-Position in Pixel}
  3851. x_dir, {x-Richtung}
  3852. y, {y-Position in Pixel}
  3853. y_dir:Word; {y-Richtung}
  3854.  
  3855. Procedure Wait_In_Display;assembler;
  3856. {Gegenstck zu Wait_In_Retrace, wartet auf Bildaufbau durch Kathodenstrahl}
  3857. asm
  3858. mov dx,3dah {Input Status 1}
  3859. @wait2:
  3860. in al,dx
  3861. test al,8h
  3862. jnz @wait2 {Display ein ? -> dann fertig}
  3863. End;
  3864. Procedure Wait_In_Retrace;assembler;
  3865. {wartet auf Retrace, setzt auáerdem durch Lesezugriff
  3866. auf Input Status 1 den ATC Flip-Flop zurck}
  3867. asm
  3868. mov dx,3dah {Input Status 1}
  3869. @wait1:
  3870. in al,dx
  3871. test al,8h
  3872. jz @wait1 {Retrace aktiv ? -> dann fertig}
  3873. End;
  3874.  
  3875. Procedure FillScreen;
  3876. {Fllt Bildschirmspeicher mit Testbild der Gr”áe 160*50 Zeichen}
  3877. var i:word;
  3878. Begin
  3879. For i:=0 to 160*50 do Begin {Zeichen-Schleife}
  3880. If i mod 10 <> 0 Then {Spaltenz„hler schreiben ?}
  3881. mem[$b800:i shl 1]:= {nein, dann '-'}
  3882. Ord('-') Else
  3883. mem[$b800:i shl 1]:= {ja, dann Spaltennummer in Zehnern}
  3884. ((i mod 160) div 10) mod 10 + Ord('0');
  3885. If i mod 160 = 0 Then {Spalte 0 ? -> Zeilenz„hler schreiben}
  3886. mem[$b800:i shl 1]:=(i div 160) mod 10 + Ord('0');
  3887. End;
  3888. End;
  3889. Procedure V_Pan(n:Byte);assembler;
  3890. {fhrt vertikales Paning durch}
  3891. asm
  3892. mov dx,3d4h {CRTC Register 8 (Inittial Row Adress)}
  3893. mov al,8
  3894. mov ah,n {Paning-Weite setzen}
  3895. out dx,ax
  3896. End;
  3897. Procedure H_Pan(n:Byte);assembler;
  3898. {fhrt vertikales Paning durch}
  3899. asm
  3900. mov dx,3c0h {ATC Index/Data Port}
  3901. mov al,13h or 32d {Register 13h (Horizontal Pixel Paning)}
  3902. out dx,al {anw„hlen; Bit 5 (Palette RAM Address Source)}
  3903. mov al,n {setzen, um Bildschirm nicht abzuschalten}
  3904. or al,32d {Paning-Wert schreiben}
  3905. out dx,al
  3906. End;
  3907.  
  3908. Begin
  3909. TextMode(3); {BIOS-Modus 3 (80*25 Zeichen, Color) setzen}
  3910. FillScreen; {Testbild aufbauen}
  3911. portw[$3d4]:=$5013; {doppelte virtuelle Screen-Breite(160 Zeichen)}
  3912. x:=0; {Koordinaten und Richtungen initialisieren}
  3913. x_dir:=1;
  3914. y:=0;
  3915. y_dir:=1;
  3916. Repeat
  3917. Inc(x,x_dir); {Bewegung in x- und y-Richtung}
  3918. Inc(y,y_dir);
  3919. If (x<=0) or (x>=80*9) {Umkehr an den R„ndern}
  3920. Then x_dir:=-x_dir;
  3921. if (y<=0) or (y>=25*16)
  3922. Then y_dir:=-y_dir;
  3923. Wait_in_Display; {warten, bis Bildaufbau l„uft}
  3924. SetStart((y div 16 *160) {Startadresse setzen (Grobscrolling}
  3925. + x div 9);
  3926. Wait_in_Retrace; {warten, bis Retrace aktiv}
  3927. V_Pan(y mod 16); {Vertikal-Panning (Feinscrolling)}
  3928. H_Pan((x-1) mod 9); {Horizontal-Panning (Feinscrolling)}
  3929. Until KeyPressed; {warten auf Taste}
  3930. TextMode(3); {und normalen Videomodus setzen}
  3931. End.
  3932. Uses Crt,Gif,ModeXLib;
  3933. Var y:Word; {derzeitiger Wert der Linear Start. Adress}
  3934. y_dir:Integer; {gibt Scroll Richtung an}
  3935. Begin
  3936. Init_ModeX; {Mode X einschalten}
  3937. Screen_Off; {Bildschirm aus}
  3938. LoadGif('320800'); {Bild laden}
  3939. p13_2_ModeX(vram_pos,rest div 4);
  3940. Screen_On;
  3941. y:=600*80; {Beginn mit Zeile 1}
  3942. y_dir:=-80; {Bewegungsrichtung +80 Byte pro Durchlauf}
  3943. Repeat
  3944. Inc(y,y_dir); {Bewegung}
  3945. WaitRetrace; {Auf Retrace warten}
  3946. SetStart(y); {und neuen Start in Register schreiben}
  3947. if (y >= 600*80) {Rand erreicht -> Richtung umdrehen}
  3948. or (y <= 80) Then y_dir:=-y_dir;
  3949. Until KeyPressed; {laufe, bis Taste gedrckt}
  3950. TextMode(3);
  3951. End.
  3952. Uses Crt,Tools,ModeXLib,Gif,Font;
  3953.  
  3954. Var Sinus:Array[0..127] of Word;{Sinus-Tabelle fr vertikale Schwingung}
  3955. t:Word; {"Zeit", Position innerhalb des Sinus}
  3956.  
  3957. Begin
  3958. Init_ModeX; {Mode X ein}
  3959. LoadGif('pfont4'); {Zeichensatz laden}
  3960. p13_2_ModeX(48000,16000); {und auf Seite 3 kopieren}
  3961. Sin_Gen(Sinus,128,Scrl_y div 2,Scrl_y div 2);
  3962. {Sinus-Tabelle fr vert. Bewegung vorbereiten}
  3963. t:=0; {Zeit startet bei 0}
  3964. Repeat
  3965. WaitRetrace; {Synchronisation}
  3966. Scrl_Move; {sichtbaren Teil nach rechts bewegen}
  3967. Scrl_Append; {rechts neue Spalte anh„ngen}
  3968. SetStart(Sinus[t and 127]*80); {fr vert. Bewegung sorgen}
  3969. Inc(t); {weiter in Sinus-Tabelle}
  3970. Until KeyPressed;
  3971. TextMode(3);
  3972. End.
  3973. Uses Crt,Gif,ModeXLib;
  3974. Var i:Word;
  3975. begin
  3976. Init_ModeX; {Mode X initialisieren}
  3977. LoadGif('beule'); {erstes Bild (Hintergrund) laden}
  3978. p13_2_ModeX(16000,16000);
  3979. LoadGif('corner'); {zweites Bild laden}
  3980. p13_2_modex(0,16000);
  3981. SetStart(16000); {Hintergrund anzeigen}
  3982. Repeat
  3983. For i:=200 downto 0 do Begin{Split-Line nach oben ziehen}
  3984. WaitRetrace;
  3985. Split(i);
  3986. If KeyPressed Then Exit;
  3987. End;
  3988. For i:=0 to 200 do Begin {Split-Line nach unten}
  3989. WaitRetrace;
  3990. Split(i);
  3991. If KeyPressed Then Exit;
  3992. End;
  3993. Until KeyPressed;
  3994. TextMode(3);
  3995. End.
  3996. {$G+}
  3997. Unit Sprites;
  3998.  
  3999. Interface
  4000.  
  4001. Type SpriteTyp=Record {Aufbau eines Sprite-Datenblocks}
  4002. Adr:Pointer; {Zeiger auf Grafik-Daten}
  4003. dtx,dty:Word; {Breite und H”he in Pixel}
  4004. px,py, {gegenw„rtige Position, optional *}
  4005. sx,sy:Integer; {gegenw„rtige Geschwindigkeit, optional *}
  4006. End;
  4007. {*: optional bedeutet, daá die Sprite-Routinen GetSprite und PutSprite
  4008. von diesen Angaben keinen Gebrauch machen, die Variablen dienen lediglich
  4009. dazu, eine Steuerung seitens des Hauptprogramms zu erleichtern}
  4010.  
  4011. Procedure GetSprite(Ofs,dtx,dty:Word;var zSprite:SpriteTyp);
  4012. {lies ein Sprite aus vscreen-Offset ofs, mit Breite dtx und H”he dty,
  4013. zsprite ist der Sprite-Record, in dem Sprite gespeichert werden soll}
  4014.  
  4015. Procedure PutSprite(pg_ofs,x,y:Integer;qsprite:spritetyp);
  4016. {kopiert Sprite aus Hauptspeicher (Lage und GrӇe werden qsprite entnommen)
  4017. auf Bildschirmspeicher Seite pg an Position (x/y)}
  4018.  
  4019.  
  4020. Implementation
  4021. Uses ModeXLib;
  4022.  
  4023. Var i:Word;
  4024.  
  4025. Procedure GetSprite;
  4026. Var ppp:Array[0..3] of Byte; {Tabelle mit Anzahl zu kopierender Pixel}
  4027. {pro Plane}
  4028. Skip:word; {Anzahl zu berspringender Bytes}
  4029. Plane_Count:Word; {Z„hler der bereits kopierten Planes}
  4030. Begin
  4031. GetMem(zsprite.adr,dtx*dty); {Hauptspeicher allokieren}
  4032. zsprite.dtx:=dtx; {im Sprite-Record Breite und H”he vermerken}
  4033. zsprite.dty:=dty;
  4034.  
  4035. i:=dtx shr 2; {Anzahl glatter Viererbl”cke}
  4036. ppp[0]:=i;ppp[1]:=i; {entspricht Mindestanzahl zu kop. Bytes}
  4037. ppp[2]:=i;ppp[3]:=i;
  4038. For i:=1 to dtx and 3 do {"berstehende" Pixel in ppp vermerken}
  4039. Inc(ppp[(i-1) and 3]); {beginnend mit Startplane Pixel anfgen}
  4040. Plane_Count:=4; {4 Planes kopieren}
  4041. asm
  4042. push ds
  4043. mov di,word ptr zsprite {zun„chst Zeiger auf Daten-Block laden}
  4044. les di,[di] {Zeiger auf Grafikdaten in es:di laden}
  4045. lea bx,ppp {bx zeigt auf ppp-Array}
  4046.  
  4047. lds si,vscreen {Zeiger auf Bild laden}
  4048. add Ofs,si {Offset der eigentlichen Sprite-Daten dazu}
  4049. @lcopy_plane: {wird einmal pro Plane durchlaufen}
  4050. mov si,ofs {si mit Startadresse der Sprite-Daten laden}
  4051. mov dx,dty {y-Z„hler mit Zeilenzahl laden}
  4052.  
  4053. xor ah,ah {ah l”schen}
  4054. mov al,ss:[bx] {al mit aktuelem ppp-Eintrag laden}
  4055. shl ax,2 {es werden jeweils 4er-Bl”cke bewegt}
  4056. sub ax,320 {Differenz zur 320 bilden}
  4057. neg ax {aus ax-320 320-ax machen}
  4058. mov skip,ax {Wert in Skip sichern}
  4059.  
  4060. @lcopy_y: {wird einmal pro Zeile durchlaufen}
  4061. mov cl,ss:[bx] {Breite aus ppp-Array laden}
  4062. @lcopy_x: {wird einmal pro Punkt durchlaufen}
  4063. movsb {Byte kopieren}
  4064. add si,3 {auf n„chsten Punkt dieser Plane}
  4065. dec cl {alle Punkte dieser Zeile kopieren}
  4066. jne @lcopy_x
  4067.  
  4068. add si,skip {danach auf Anfang der n„chsten Zeile}
  4069. dec dx {alle Zeilen kopieren}
  4070. jne @lcopy_y
  4071.  
  4072. inc bx {auf n„chsten ppp-Eintrag positionieren}
  4073. inc ofs {auf neuen Plane-Start positionieren}
  4074. dec plane_count {alle Planes kopieren}
  4075. jne @lcopy_plane
  4076.  
  4077. pop ds
  4078. End;
  4079. End;
  4080.  
  4081. Procedure PutSprite;
  4082. var plane_count, {Z„hler der bereits kopierten Planes}
  4083. planemask:Byte; {maskiert Write-Plane in TS-Register 2}
  4084. Skip, {Anzahl zu berspringender Bytes}
  4085. ofs, {aktueller Offset im Bildschirmspeicher}
  4086. plane, {Nummer der aktuellen Plane}
  4087. Breite, {Breite zu kopierender Bytes in einer Zeile,}
  4088. dty:Word; {H”he}
  4089. quelle:Pointer; {Zeiger auf Grafikdaten, wenn ds ver„ndert}
  4090. clip_lt, clip_rt:integer; {Anzahl links und rechts berstehender PIXEL}
  4091. clipakt_lt, {bei aktueller Plane aktive Anzahl}
  4092. clipakt_rt, {berstehender BYTES}
  4093. clip_dn,clip_up:Word; {Anzahl oben und unten berstehender ZEILEN}
  4094.  
  4095. ppp:Array[0..3] of Byte; {Anzahl Pixel pro Plane}
  4096. cpp:Array[0..3] of Byte; {berstehende BYTES pro Plane}
  4097.  
  4098. Begin
  4099. if (x > 319) or {Darstellung berflssig, }
  4100. (x+qsprite.dtx < 0) or {weil gar nicht im Bild ?}
  4101. (y > 199) or
  4102. (y+qsprite.dty < 0) then exit;
  4103. clip_rt:=0; {im Normalfall kein Clipping}
  4104. clip_lt:=0; {-> alle Clipping-Variablen auf 0}
  4105. clip_dn:=0;
  4106. clip_up:=0;
  4107. clipakt_rt:=0;
  4108. clipakt_lt:=0;
  4109. with qsprite do begin
  4110. if y+dty > 200 then begin {erster Clipping Fall: unten}
  4111. clip_dn:=(y+dty-200); {berstehende Zeilen vermerken}
  4112. dty:=200-y; {und Sprite-H”he reduzieren}
  4113. End;
  4114. if y<0 then begin {zweiter Clipping Fall: oben}
  4115. clip_up:=-y; {berstehende Zeilen vermerken}
  4116. dty:=dty+y; {und Sprite-H”he reduzieren}
  4117. y:=0; {Start-y ist 0, weil oberer Bildrand}
  4118. End;
  4119. if x+dtx > 320 then begin {dritter Clipping Fall: rechts}
  4120. clip_rt:=x+dtx-320; {berstehende Pixel vermerken}
  4121. dtx:=320-x; {Breite reduzieren}
  4122. End;
  4123. if x<0 then begin {vierter Clipping Fall: links}
  4124. clip_lt:=-x; {berstehende Pixel vermerken}
  4125. plane:=4-(clip_lt mod 4); {neue Startplane fr Spalte 0 berechnen}
  4126. plane:=plane and 3; {diese auf 0..3 reduzieren}
  4127. ofs:=pg_ofs+80*y+((x+1) div 4) - 1; {Ofs auf korrekten 4er-Block setzen}
  4128. x:=0; {Darstellung in Spalte beginnen}
  4129. End Else Begin {rechts kein Clipping ?}
  4130. plane:=x mod 4; {dann konventionelle Berechnung von Plane}
  4131. ofs:=pg_ofs+80*y+(x div 4); {und Offset}
  4132. End;
  4133. End;
  4134. Quelle:=qsprite.adr; {Zeiger Grafik-Daten}
  4135. dty:=qsprite.dty; {und H”he in lok. Variablen sichern}
  4136. Breite:=0; {Breite und Skip vorinitialisieren}
  4137. Skip:=0;
  4138.  
  4139. i:=qsprite.dtx shr 2; {Anzahl glatter Viererbl”cke}
  4140. ppp[0]:=i;ppp[1]:=i; {entspricht Mindestanzahl zu kop. Bytes}
  4141. ppp[2]:=i;ppp[3]:=i;
  4142. For i:=1 to qsprite.dtx and 3 do{"berstehende" Pixel in ppp vermerken}
  4143. Inc(ppp[(plane+i - 1) and 3]);{beginnend mit Startplane Pixel anfgen}
  4144.  
  4145. i:=(clip_lt+clip_rt) shr 2;
  4146. cpp[0]:=i;cpp[1]:=i; {Clipping-Vorgabe : alle Seiten 0}
  4147. cpp[2]:=i;cpp[3]:=i;
  4148. For i:=1 to clip_rt and 3 do {wenn rechts Clipping entsprechende Anzahl}
  4149. Inc(cpp[i-1]); {in Planes eintragen}
  4150. For i:=1 to clip_lt and 3 do {wenn rechts Clipping entsprechende Anzahl}
  4151. Inc(cpp[4-i]); {in Planes eintragen}
  4152.  
  4153. asm
  4154. mov dx,3ceh {GDC Register 5 (GDC Mode)}
  4155. mov ax,4005h {auf Write Mode 0 setzen}
  4156. out dx,ax
  4157. push ds {ds sichern}
  4158. mov ax,0a000h {Zielsegment (VGA) laden}
  4159. mov es,ax
  4160.  
  4161. lds si,quelle {Quelle (Zeiger auf Grafikdaten) nach ds:si}
  4162. mov cx,plane {Start-Planemaske erstellen}
  4163. mov ax,1 {dazu Bit 0 um Plane nach links schieben}
  4164. shl ax,cl
  4165. mov planemask,al {Maske sichern}
  4166. shl al,4 {auch in oberes Nibble eintragen}
  4167. or planemask,al
  4168. mov plane_count,4 {4 Planes zu kopieren}
  4169. @lplane: {wird einmal pro Plane durchlaufen}
  4170. mov cl,byte ptr plane {aktuelle Plane laden}
  4171. mov di,cx {in di}
  4172. mov cl,byte ptr ppp[di] {cx mit zugeh”riger ppp-Anzahl laden}
  4173. mov byte ptr Breite,cl {Skip jeweils neu ausrechnen}
  4174. mov ax,80 {dazu Differenz 80-Breite bilden}
  4175. sub al,cl
  4176. mov byte ptr skip,al {und in skip schreiben}
  4177.  
  4178. mov al,byte ptr cpp[di] {Plane-spezifische Clipping-Weite laden}
  4179. cmp clip_lt,0 {wenn links kein Clipping, weiter mit rechts}
  4180. je @rechts
  4181. mov clipakt_lt,ax {in clip_akt_lt sichern}
  4182. sub Breite,ax {Breite zu kopierender Bytes reduzieren}
  4183. jmp @clip_rdy {rechts kein Clipping}
  4184. @rechts: {wenn links kein Clipping}
  4185. mov clipakt_rt,ax {dazu Clipping fr alle Planes, in clip_akt}
  4186. @clip_rdy:
  4187. mov ax,Breite {Gesamtbreite in Byte berechnen}
  4188. add ax,clipakt_rt
  4189. add ax,clipakt_lt
  4190. mul clip_up {mit Anzahl Zeilen des oberen Clipping mul.}
  4191. add si,ax {diese Bytes werden nicht dargestellt}
  4192.  
  4193. mov cx,Breite {cx mit Breite laden}
  4194. or cl,cl {Breite 0, dann Plane fertig}
  4195. je @plane_fertig
  4196.  
  4197. mov di,ofs {Zieloffset im Bildschirmspeicher nach di}
  4198. mov ah,planemask {Planemaske auf bit [0..3] reduzieren}
  4199. and ah,0fh
  4200. mov al,02h {und ber TS - Register 2 (Write Plane Mask)}
  4201. mov dx,3c4h {setzen}
  4202. out dx,ax
  4203. mov bx,dty {y-Z„hler initialisieren}
  4204. @lcopy_y: {y-Schleife, pro Zeile einmal durchlaufen}
  4205. add si,clipakt_lt {Quellzeiger um linkes Clipping weiter}
  4206. add di,clipakt_lt {auch Zielzeiger}
  4207. @lcopy: {x-Schleife, pro Punkt einmal durchlaufen}
  4208. lodsb {Byte holen}
  4209. or al,al {wenn 0, dann berspringen}
  4210. je @Wert0
  4211. stosb {ansonsten: setzen}
  4212. @entry:
  4213. loop @lcopy {und Schleife weiter}
  4214.  
  4215. add si,clipakt_rt {nach kompletter Zeile rechtes Clipping}
  4216.  
  4217. dec bx {y-Z„hler weiter}
  4218. je @plane_fertig {y-Z„hler = 0, dann n„chste Plane}
  4219. add di,skip {sonst auf n„chsten Zeilenanfang springen}
  4220. mov cx,Breite {x-Z„hler reinitialisieren,}
  4221. jmp @lcopy_y {wieder in y-Schleife springen}
  4222. @wert0: {Sprite-Farbe 0:}
  4223. inc di {Zielbyte berspringen}
  4224. jmp @entry {und wieder in Schleife zurck}
  4225. @plane_fertig: {hier ist y-Schleife beendet}
  4226. mov ax,Breite {Gesamtbreite in Byte berechnen}
  4227. add ax,clipakt_rt
  4228. add ax,clipakt_lt
  4229. mul clip_dn {mit Anzahl Zeilen des unteren Clipping mul.}
  4230. add si,ax {diese Bytes werden nicht dargestellt}
  4231. rol planemask,1 {n„chste Plane maskieren}
  4232. mov cl,planemask {plane 0 selektiert ?}
  4233. and cx,1 {(Bit 1 gesetzt), dann}
  4234. add ofs,cx {Zieloffset erh”hen um 1 (cx Bit 1 !)}
  4235. inc plane {Plane-Nummer (Index in ppp) weiter}
  4236. and plane,3 {auf 0 bis 3 reduzieren}
  4237. dec plane_count {schon 4 Planes kopiert ?, dann Ende}
  4238. jne @lplane
  4239. pop ds {ds restaurieren, und Tschá}
  4240. End;{asm}
  4241. End;
  4242.  
  4243. Begin
  4244. End.
  4245. Uses Crt,Gif,ModeXLib,Sprites;
  4246.  
  4247. Const Sprite_Anzahl=3; {Anzahl im Programm verwendeter Sprites}
  4248.  
  4249. Var Sprite:Array[1..Sprite_Anzahl] of SpriteTyp;
  4250. {Daten-Records der Sprites}
  4251. i:Word; {Z„hler}
  4252.  
  4253. Begin
  4254. Init_ModeX; {Mode X einschalten}
  4255. LoadGif('sprites'); {Bild mit den drei Sprites laden}
  4256. GetSprite(62 +114*320,58,48,Sprite[1]); {Koordinaten (62/114), Breite 58*48}
  4257. GetSprite(133+114*320,58,48,Sprite[2]); {(133/114), 58*48}
  4258. GetSprite(203+114*320,58,48,Sprite[3]); {(203/114), 58*48}
  4259. {die drei Sprites laden}
  4260. LoadGif('phint'); {Hintergrundbild laden}
  4261. p13_2_ModeX(48000,16000); {und auf Hintergrundseite kopieren}
  4262. With Sprite[1] do Begin {Koordinaten und Geschwindigkeiten}
  4263. px:=160;py:=100; {aller drei Sprites auf (willkrliche Werte)}
  4264. sx:=1;sy:=2;
  4265. End;
  4266. With Sprite[2] do Begin
  4267. px:=0;py:=0;
  4268. sx:=1;sy:=-1;
  4269. End;
  4270. With Sprite[3] do Begin
  4271. px:=250;py:=150;
  4272. sx:=-2;sy:=-1;
  4273. End;
  4274. Repeat
  4275. CopyScreen(vpage,48000); {Hintergrundbild auf aktuelle Seite}
  4276. For i:=1 to Sprite_Anzahl do{fr alle 3 Sprites durchlaufen}
  4277. With Sprite[i] do Begin
  4278. Inc(px,sx); Inc(py,sy); {Bewegung}
  4279. If (px < -dtx div 2) {am linken oder rechten Rand ? -> umkehren}
  4280. or (px > 320-dtx div 2) Then sx:=-sx;
  4281. If (py < -dty div 2) {am oberen oder unteren Rand ? -> umkehren}
  4282. or (py > 200-dty div 2) Then sy:=-sy;
  4283. PutSprite(vpage,px,py,Sprite[i]);
  4284. {Sprite zeichnen}
  4285. End;
  4286. switch; {auf berechnete Seite umschalten}
  4287. WaitRetrace; {Bildschirm darf erst nach n„chstem Retrace}
  4288. Until KeyPressed; {wieder ver„ndert werden}
  4289. ReadLn;
  4290. TextMode(3);
  4291. End.
  4292. uses Crt,ModeXLib,Gif;
  4293. Begin
  4294. Init_ModeX; {Einschalten des Mode X}
  4295. LoadGif('squeeze'); {Laden des Bilds}
  4296. p13_2_ModeX(vram_pos,rest div 4);
  4297. ReadLn; {Warten auf Enter}
  4298. Squeeze; {Zusammenschieben des Bilds}
  4299. ReadLn;
  4300. TextMode(3);
  4301. End.
  4302. Uses Crt;
  4303. Var Sterne:Array[0..500] of Record
  4304. x,y,Ebene:Integer;
  4305. End;
  4306. st_nr:Word;
  4307.  
  4308. Procedure PutPixel(x,y,col:word);assembler;
  4309. {setzt Punkt (x/y) auf Farbe col (Mode 13h)}
  4310. asm
  4311. mov ax,0a000h {Segment laden}
  4312. mov es,ax
  4313. mov ax,320 {Offset = Y*320 + X}
  4314. mul y
  4315. add ax,x
  4316. mov di,ax {Offset laden}
  4317. mov al,byte ptr col {Farbe laden}
  4318. mov es:[di],al {und Punkt setzen}
  4319. End;
  4320.  
  4321. Begin
  4322. Randomize; {Zufallszahlen initialisieren}
  4323. asm mov ax,13h; int 10h End; {Mode 13h setzen}
  4324. Repeat {pro Bildaufbau einmal ausgefhrt}
  4325. For St_nr:=0 to 500 do Begin{fr jeden Stern neue Posit. berechnen}
  4326. With Sterne[st_nr] do Begin
  4327. PutPixel(x,y,0); {alten Punkt l”schen}
  4328. Dec(x,Ebene shr 5 + 1); {weiterbewegen}
  4329. if x <= 0 Then Begin {links raus ?}
  4330. x:=319; {dann neu initialisieren}
  4331. y:=Random(200);
  4332. Ebene:=Random(256);
  4333. End;
  4334. PutPixel(x,y,Ebene shr 4 + 16); {neuen Punkt setzen}
  4335. End;
  4336. End;
  4337. Until KeyPressed; {Lauf, bis Taste gedrckt}
  4338. TextMode(3);
  4339. End.
  4340. {$G+}
  4341. Uses ModeXLib,Crt;
  4342. Var Sterne:Array[0..500] of Record
  4343. x,y,Ebene:Integer;
  4344. End;
  4345. st_nr:Word;
  4346. vscreen:Pointer;
  4347. vpage:Word;
  4348. palette:Array[0..768] of Byte;
  4349.  
  4350. Procedure PutPixel(x,y,col:word);assembler;
  4351. {setzt Punkt (x/y) auf Farbe col (Mode X)}
  4352. asm
  4353. mov ax,0a000h {Segment laden}
  4354. mov es,ax
  4355.  
  4356. mov cx,x {Write Plane bestimmen}
  4357. and cx,3 {als x mov 4}
  4358. mov ax,1
  4359. shl ax,cl {entsprechendes Bit setzen}
  4360. mov ah,al
  4361. mov dx,03c4h {Timing Sequenzer}
  4362. mov al,2 {Register 2 - Write Plane Mask}
  4363. out dx,ax
  4364.  
  4365. mov ax,80 {Offset = Y*80 + X div 4}
  4366. mul y
  4367. mov di,ax
  4368. mov ax,x
  4369. shr ax,2
  4370. add di,ax {Offset laden}
  4371. mov al,byte ptr col {Farbe laden}
  4372. mov es:[di],al {und Punkt setzen}
  4373. End;
  4374.  
  4375. Begin
  4376. Randomize; {Zufallszahlen initialisieren}
  4377. Init_ModeX;
  4378. Repeat {pro Bildaufbau einmal ausgefhrt}
  4379. For St_nr:=0 to 500 do Begin{fr jeden Stern neue Posit. berechnen}
  4380. With Sterne[st_nr] do Begin
  4381. PutPixel(x,y,0); {alten Punkt l”schen}
  4382. Dec(x,Ebene shr 5 + 1); {weiterbewegen}
  4383. if x <= 0 Then Begin {links raus ?}
  4384. x:=319; {dann neu initialisieren}
  4385. y:=Random(200);
  4386. Ebene:=Random(256);
  4387. End;
  4388. PutPixel(x,y,Ebene shr 4 + 16); {neuen Punkt setzen}
  4389. End;
  4390. End;
  4391. Until KeyPressed; {Lauf, bis Taste gedrckt}
  4392. TextMode(3);
  4393. End.
  4394. Unit Tools;
  4395.  
  4396. Interface
  4397.  
  4398. procedure sin_gen(var tabelle:Array of word;periode,amplitude,offset:word);
  4399. Procedure Draw_Ansi(Name:String);
  4400.  
  4401.  
  4402. Implementation
  4403.  
  4404. procedure sin_gen(var tabelle:Array of word;periode,amplitude,offset:word);
  4405. {berechet eine Sinus-Tabelle der L„nge periode vor,
  4406. legt diese im Array tabelle ab.
  4407. Dabei wird die "H”he" in der Variablen Amplitude und
  4408. die Lage des Nullpunkts in offset verlangt}
  4409. Var i:Word;
  4410. Begin
  4411. for i:=0 to periode-1 do
  4412. tabelle[i]:=round(sin(i*2*pi/periode)*amplitude)+offset;
  4413. End;
  4414.  
  4415. Procedure Draw_Ansi(Name:String);
  4416. {gibt ein Ansi-File auf dem Bildschirm aus (ANSI.SYS erforderlich !)}
  4417. Var Ansi:File; {Ansi-Datei}
  4418. StdOut:File; {Standard-Ausgabe Datei (Int 21h)}
  4419. Puffer:Pointer; {Zwischenpuffer fr Bildschirm}
  4420. Groesse:Word; {DateigrӇe}
  4421. Begin
  4422. Assign(Ansi,Name); {Ansi-File ”ffnen}
  4423. Assign(StdOut,'CON'); {Ausgabe-File ”ffnen}
  4424.  
  4425. Reset(Ansi,1); {Ansi-File mit BlockgrӇe 1 Byte init.}
  4426. Groesse:=FileSize(Ansi); {GrӇe (in Byte) bestimmen}
  4427. Reset(Ansi,Groesse); {Datei mit dieser GrӇe erneut initialisieren}
  4428. Reset(StdOut,Groesse); {Ausgabe-Datei initialisieren}
  4429.  
  4430. GetMem(Puffer,Groesse); {Puffer allokieren}
  4431. BlockRead(Ansi,Puffer^,1); {File lesen ...}
  4432. BlockWrite(StdOut,Puffer^,1); {... und ausgeben}
  4433. FreeMem(Puffer,Groesse); {Puffer freigeben}
  4434. Close(Ansi); {Dateien schlieáen}
  4435. Close(StdOut);
  4436. End;
  4437.  
  4438. Begin
  4439. End.
  4440. Unit Var_3d;
  4441.  
  4442. Interface
  4443. Uses Tools;
  4444. Const Txt_Anzahl=5; {Anzahl benutzter Texturen}
  4445. Txt_Groesse: {GrӇenangaben der Texturen}
  4446. Array[0..Txt_Anzahl-1] of Word=
  4447. ($0a0a,$0a0a,$0a0a,$0a0a,$0a0a);
  4448.  
  4449. Var vz:Word; {Verschiebung in den Bildschirm hinein}
  4450. rotx, {Rotationswinkel}
  4451. roty,
  4452. rotz:word; {3 Grad-Schritte}
  4453. fl_sort:Boolean; {Fl„chen sortieren ?}
  4454. Fuellen:Boolean; {true: Fllen / false:Linien}
  4455. fl_ruecken:Boolean; {Fl„chenrcken unterdrcken ?}
  4456. Texture:Boolean; {Texturen verwenden ?}
  4457. lightsrc:Boolean; {Lichtquelle verwenden ?}
  4458. Glas:Boolean; {Glas-Fl„chen ?}
  4459.  
  4460. Txt_Daten:Array[0..Txt_Anzahl-1] of Pointer;
  4461. {Lage der Texturen im Speicher}
  4462. Txt_Offs:Array[0..Txt_Anzahl-1] of Word;
  4463. {Offset innerhalb des Textur-Bilds}
  4464. Txt_Pic:Pointer; {Zeiger auf Textur-Bild}
  4465.  
  4466. Sinus:Array[0..149] of Word;{Sinus-Tabelle fr Rotationen}
  4467.  
  4468. Implementation
  4469. Begin
  4470. Sin_Gen(Sinus,120,16384,0);
  4471. Move(Sinus[0],Sinus[120],60);
  4472. End.
  4473. {$G+}
  4474. Uses Crt,Gif,ModeXLib;
  4475.  
  4476. Var x,y:Integer; {Koordinaten des Trapez}
  4477.  
  4478. Procedure Draw_Voxel;external;
  4479. {$l voxel.obj}
  4480.  
  4481. Begin
  4482. asm mov ax,0; int 33h End; {Maustreiber zurcksetzen}
  4483. Init_ModeX; {Mode X einschalten}
  4484. LoadGif('landsc3'); {Landschaft laden}
  4485. x:=195; {Startkoordinate festlegen}
  4486. y:=130;
  4487. Repeat
  4488. ClrX($0f); {Bildschirm l”schen}
  4489. Draw_Voxel; {Landschaft zeichnen}
  4490. Switch; {fertige Bildschirmseite aktivieren}
  4491. WaitRetrace; {auf Retrace warten}
  4492. asm
  4493. mov ax,000bh {Funktion 0bh: relative Koordinaten lesen}
  4494. int 33h
  4495. sar cx,2 {Division durch 2}
  4496. sar dx,2
  4497. add x,cx
  4498. add y,dx
  4499. End;
  4500. If x < 0 Then x:=0; If x > 130 Then x:=130;
  4501. If y < 0 Then y:=0; If y > 130 Then y:=130;
  4502. Until KeyPressed; {bis Taste}
  4503. TextMode(3);
  4504. End.
  4505. Uses Crt,Gif,ModeXLib,Tools;
  4506. const y=246; {H”he und Position hier festgelgt}
  4507. hoehe=90; {drfen natrich auch Variablen sein}
  4508.  
  4509. Var Sinus:Array[0..63] of Word; {Sinustabelle, wird sp„ter gefllt}
  4510. i:Word; {tempor„rer Z„hler}
  4511.  
  4512. Procedure Make_Wob(wob_pos,wob_hoehe,wob_offset:word);external;
  4513. {$l wobbler}
  4514.  
  4515. begin
  4516. TextMode(3); {Wobbler funktioniert in JEDEM Videomodus ! }
  4517.  
  4518. Draw_Ansi('db6.ans'); {Ansi-File laden}
  4519. Sin_Gen(Sinus,64,4,83); {Sinus vorberechnen}
  4520. CRTC_Unprotect; {horizontales Timing freischalten}
  4521. ReadKey; {warten}
  4522. i:=0;
  4523. Repeat
  4524. inc(i); {Bewegung erzeugen}
  4525. Make_Wob(y,hoehe,i); {Wobble zeichnen}
  4526. Until KeyPressed;
  4527. CRTC_Protect; {CRTC wieder schtzen}
  4528. End.
  4529. .286
  4530. w equ word ptr
  4531.  
  4532. code segment public
  4533. assume cs:code
  4534. public wurzel
  4535. public wurzfkt
  4536. ;Radikand Wert in dx:ax
  4537. wurzel proc pascal ;Ergebnis in ax (Function)
  4538. .386
  4539. xor esi,esi ;Zwischenergebnis (in esi) l”schen
  4540. shrd ebx,edx,16d ;dx nach ebx (obere 16 Bit)
  4541. mov bx,ax ;ax nach ebx (unten) - dx:ax jetzt in ebx
  4542. xor edx,edx ;edx l”schen
  4543. mov ecx,ebx ;Startwert in ecx sichern
  4544. mov eax,ebx ;auch eax laden
  4545.  
  4546. iterat:
  4547. idiv ebx ;durch Xn dividieren
  4548. xor edx,edx ;Rest interessiert nicht
  4549. add eax,ebx ;Xn addieren
  4550. shr eax,1 ;durch 2 dividieren
  4551. sub esi,eax ;Differenz zum vorherigen Ergebnis
  4552. cmp esi,1 ;kleiner gleich 1
  4553. jbe fertig ;dann fertig
  4554. mov esi,eax ;Ergebnis als vorheriges sichern
  4555. mov ebx,eax ;als Xn vermerken
  4556. mov eax,ecx ;Startwert fr Division erneut laden
  4557. jmp iterat ;und zum Schleifenstart
  4558. fertig:
  4559. ret ;Ergebnis steht jetzt in eax
  4560. wurzel endp
  4561.  
  4562. wurzfkt proc pascal a:dword ;bersetzt Prozedur in Pascal-Funktion
  4563. mov ax,word ptr a ;Parameter in Register schreiben
  4564. mov dx,word ptr a+2
  4565. call wurzel ;und Wurzel ziehen
  4566. ret
  4567. wurzfkt endp
  4568.  
  4569. code ends
  4570. end
  4571. .286 ;wenigstens 286-Befehle aktivieren
  4572. e equ db 66h ;Operand Size Prefix (32-Bit Befehle)
  4573. w equ word ptr
  4574.  
  4575. code segment public
  4576. assume cs:code
  4577. public wurzel
  4578. public wurzfkt
  4579. ;Radikand Wert in dx:ax
  4580. wurzel proc pascal ;Ergebnis in ax (Function)
  4581. e ;mit 32 Bit rechnen
  4582. xor si,si ;Zwischenergebnis (in esi) l”schen
  4583. db 66h,0fh,0ach,0d3h,10h ;shrd ebx,edx,16d - dx nach ebx (obere 16 Bit)
  4584. mov bx,ax ;ax nach ebx (unten) - dx:ax jetzt in ebx
  4585. e
  4586. xor dx,dx ;edx l”schen
  4587. e
  4588. mov cx,bx ;Startwert in ecx sichern
  4589. e
  4590. mov ax,bx ;auch eax laden
  4591.  
  4592. iterat:
  4593. e
  4594. idiv bx ;durch Xn dividieren
  4595. e
  4596. xor dx,dx ;Rest interessiert nicht
  4597. e
  4598. add ax,bx ;Xn addieren
  4599. e
  4600. shr ax,1 ;durch 2 dividieren
  4601. e
  4602. sub si,ax ;Differenz zum vorherigen Ergebnis
  4603. e
  4604. cmp si,1 ;kleiner gleich 1
  4605. jbe fertig ;dann fertig
  4606. e
  4607. mov si,ax ;Ergebnis als vorheriges sichern
  4608. e
  4609. mov bx,ax ;als Xn vermerken
  4610. e
  4611. mov ax,cx ;Startwert fr Division erneut laden
  4612. jmp iterat ;und zum Schleifenstart
  4613. fertig:
  4614. ret ;Ergebnis steht jetzt in eax
  4615. wurzel endp
  4616.  
  4617. wurzfkt proc pascal a:dword ;bersetzt Prozedur in Pascal-Funktion
  4618. mov ax,word ptr a ;Parameter in Register schreiben
  4619. mov dx,word ptr a+2
  4620. call wurzel ;und Wurzel ziehen
  4621. ret
  4622. wurzfkt endp
  4623.  
  4624. code ends
  4625. endType Fest=Record {Aufbau einer Festkommazahl}
  4626. Vork,
  4627. Nachk:Integer
  4628. End;
  4629.  
  4630. Var Var1, {Beispielvariablen}
  4631. Var2:Fest;
  4632.  
  4633. Const Nachk_Max=100; {2 Nachkommastellen}
  4634. Nachk_Stellen=2;
  4635.  
  4636. Function Strg(FZahl:Fest):String;
  4637. {wandelt eine Festkommazahl in einen String um}
  4638. Var Nachk_Str, {String zum bilden des Nachkommateils}
  4639. Vork_Str:String; {String zum bilden des Vorkommateils}
  4640. i:Word;
  4641. Begin
  4642. If FZahl.Nachk < 0 Then {bei Ausgabe Nachkommateil ohne Vorzeichen}
  4643. FZahl.Nachk:=-FZahl.Nachk;
  4644. Str(FZahl.Nachk:Nachk_Stellen,Nachk_Str);
  4645. {Nachkommstring generieren}
  4646. For i:=0 to Nachk_Stellen do {und Leerzeichen durch 0en ersetzen}
  4647. If Nachk_Str[i] = ' ' Then Nachk_Str[i]:='0';
  4648. Str(FZahl.Vork,Vork_Str); {Vorkommstring generieren}
  4649. Strg:=Vork_Str+','+Nachk_Str; {String zusammensetzen}
  4650. End;
  4651.  
  4652. Procedure Convert(RZahl:Real;Var FZahl:Fest);
  4653. {Konvertiert Real RZahl in Festkommazahl FZahl}
  4654. Begin
  4655. FZahl.Vork:=Trunc(RZahl);
  4656. {Vorkommateil bestimmen}
  4657. FZahl.Nachk:=Trunc(Round(Frac(RZahl)*Nachk_Max));
  4658. {Nachommateil bestimmen und als ganze Zahl speichern}
  4659. End;
  4660.  
  4661. Procedure Adjust(Var FZahl:Fest);
  4662. {bringt bergebene Festkommazahl wieder in legales Format}
  4663. Begin
  4664. If FZahl.Nachk > Nachk_Max Then Begin
  4665. Dec(FZahl.Nachk,Nachk_Max); {wenn Nachkommateil positiv bergelaufen}
  4666. Inc(FZahl.Vork); {zurcksetzen und Vorkommateil verringern}
  4667. End;
  4668. If FZahl.Nachk < -Nachk_Max Then Begin
  4669. Inc(FZahl.Nachk,Nachk_Max); {wenn Nachkommateil positiv bergelaufen}
  4670. Dec(FZahl.Vork); {zurcksetzen und Vorkommateil erh”hen}
  4671. End;
  4672. End;
  4673.  
  4674. Procedure Add(Var Summe:Fest;FZahl1,FZahl2:Fest);
  4675. {Addiert FZahl1 und FZahl2 und legt Ergebnis in Summe ab}
  4676. Var Ergebnis:Fest;
  4677. Begin
  4678. Ergebnis.Nachk:=FZahl1.Nachk+FZahl2.Nachk;
  4679. {Nachkommateil addieren}
  4680. Ergebnis.Vork:=FZahl1.Vork+FZahl2.Vork;
  4681. {Vorkommateil addieren}
  4682. Adjust(Ergebnis);
  4683. {Ergebnis wieder auf richtiges Format bringen}
  4684. Summe:=Ergebnis;
  4685. End;
  4686.  
  4687. Procedure Sub(Var Differenz:Fest;FZahl1,FZahl2:Fest);
  4688. {Subtrahiert FZahl1 von FZahl2 und legt Ergebnis in Differenz ab}
  4689. Var Ergebnis:Fest;
  4690. Begin
  4691. Ergebnis.Nachk:=FZahl1.Nachk-FZahl2.Nachk;
  4692. {Nachkommateil subtrahieren}
  4693. Ergebnis.Vork:=FZahl1.Vork-FZahl2.Vork;
  4694. {Vorkommateil subtrahieren}
  4695. Adjust(Ergebnis);
  4696. {Ergebnis wieder auf richtiges Format bringen}
  4697. Differenz:=Ergebnis;
  4698. End;
  4699.  
  4700. Procedure Mul(Var Produkt:Fest;FZahl1,FZahl2:Fest);
  4701. {multipliziert FZahl1 und FZahl und legt Ergebnis in Produkt ab}
  4702. Var Ergebnis:LongInt;
  4703. Begin
  4704. Ergebnis:=Var1.Vork*Nachk_Max + Var1.Nachk;
  4705. {ersten Faktor bilden}
  4706. Ergebnis:=Ergebnis * (Var2.Vork*Nachk_Max + Var2.Nachk);
  4707. {zweiten Faktor bilden}
  4708. Ergebnis:=Ergebnis div Nachk_Max;
  4709. {Hilfsfaktor Nachk_Max ausgleichen}
  4710. Produkt.Vork:=Ergebnis div Nachk_Max;
  4711. {Vor- und Nachkommateil extrahieren}
  4712. Produkt.Nachk:=Ergebnis mod Nachk_Max;
  4713. End;
  4714.  
  4715. Procedure Divi(Var Quotient:Fest;FZahl1,FZahl2:Fest);
  4716. {dividiert FZahl1 durch FZahl2 und legt Ergebnis in Quotient ab}
  4717. Var Ergebnis:LongInt; {Zwischenergebnis}
  4718. Begin
  4719. Ergebnis:=FZahl1.Vork*Nachk_Max + FZahl1.Nachk;
  4720. {Z„hler bilden}
  4721. Ergebnis:=Ergebnis * Nachk_Max div (FZahl2.Vork*Nachk_Max+FZahl2.Nachk);
  4722. {durch Nenner teilen, vorher mehr Stellen zur Verfgung stellen}
  4723. Quotient.Vork:=Ergebnis div Nachk_Max;
  4724. {Vor- und Nachkommateil extrahieren}
  4725. Quotient.Nachk:=Ergebnis mod Nachk_Max;
  4726. End;
  4727.  
  4728. Begin
  4729. WriteLn;
  4730. Convert(-10.2,Var1); {zwei Demo-Zahlen laden}
  4731. Convert(25.3,Var2);
  4732.  
  4733. {zur Demonstration einige Rechnungen:}
  4734.  
  4735. Write(Strg(Var1),'*',Strg(Var2),'= ');
  4736. Mul(Var1,Var1,Var2);
  4737. WriteLn(Strg(Var1));
  4738.  
  4739. Write(Strg(Var1),'-',Strg(Var2),'= ');
  4740. Sub(Var1,Var1,Var2);
  4741. WriteLn(Strg(Var1));
  4742.  
  4743. Write(Strg(Var1),'/',Strg(Var2),'= ');
  4744. Divi(Var1,Var1,Var2);
  4745. WriteLn(Strg(Var1));
  4746.  
  4747. Write(Strg(Var1),'+',Strg(Var2),'= ');
  4748. Add(Var1,Var1,Var2);
  4749. WriteLn(Strg(Var1));
  4750. End.
  4751. {$n-} {Coprozessor aus}
  4752. Function Wurzfkt(Radikand:LongInt):Integer;external;
  4753. {$l Wurzel}
  4754. {Hier muá der Pfad des Assembler-Moduls Wurzel.obj eingetragen werden !}
  4755.  
  4756. var i:word; {Schleifenz„hler}
  4757. n:Integer; {Ergebnis der Integer-Rechnung}
  4758. r:Real; {Ergebnis der Real-Rechnung}
  4759.  
  4760. Procedure Wurzel_neu; {berechnet Wurzel nach Integer-N„herung}
  4761. Begin
  4762. For i:=1 to 10000 do {10000 mal durchlaufen,}
  4763. n:=Wurzfkt(87654321); {um Geschwindigkeitsvergleich zu erhalten}
  4764. End;
  4765.  
  4766. Procedure Wurzel_real; {berechnet Wurzel durch Pascal-Funktion}
  4767. Begin
  4768. For i:=1 to 10000 do {10000 mal durchlaufen,}
  4769. r:=Sqrt(87654321); {um Geschwindigkeitsvergleich zu erhalten}
  4770. End;
  4771.  
  4772. Begin
  4773. writeLn;
  4774. WriteLn('Wurzelberechnung durch Pascal - Funktion beginnt');
  4775. Wurzel_Real;
  4776. WriteLn('Ergebnis: ',r:0:0);
  4777. WriteLn('Wurzelberechnung durch Integer - Funktion beginnt');
  4778. Wurzel_neu;
  4779. WriteLn('Ergebnis: ',n);
  4780. End.
  4781. unit DMA;
  4782.  
  4783. interface
  4784.  
  4785. TYPE DMAarray = array[0..7] of byte;
  4786.  
  4787. CONST
  4788. { Adressen der DMA-Controller }
  4789. DMA_Adress : DMAarray = ($00,$02,$04,$06,$C0,$C4,$C8,$CC);
  4790. DMA_Count : DMAarray = ($01,$03,$05,$07,$C2,$C6,$CA,$CE);
  4791. DMARead_status_Reg : DMAarray = ($08,$08,$08,$08,$D0,$D0,$D0,$D0);
  4792. DMAWrite_status_Reg : DMAarray = ($08,$08,$08,$08,$D0,$D0,$D0,$D0);
  4793. DMAWrite_requ_Reg : DMAarray = ($09,$09,$09,$09,$D2,$D2,$D2,$D2);
  4794. DMAWr_single_mask_Reg : DMAarray = ($0A,$0A,$0A,$0A,$D4,$D4,$D4,$D4);
  4795. DMAWr_mode_Reg : DMAarray = ($0B,$0B,$0B,$0B,$D6,$D6,$D6,$D6);
  4796. DMAClear_Flipflop : DMAarray = ($0C,$0C,$0C,$0C,$D8,$D8,$D8,$D8);
  4797. DMARead_Temp_Reg : DMAarray = ($0D,$0D,$0D,$0D,$DA,$DA,$DA,$DA);
  4798. DMAMaster_Clear : DMAarray = ($0D,$0D,$0D,$0D,$DA,$DA,$DA,$DA);
  4799. DMA_Clear_Mask_Reg : DMAarray = ($0E,$0E,$0E,$0E,$DC,$DC,$DC,$DC);
  4800. DMA_Wr_All_Mask_Reg : DMAarray = ($0F,$0F,$0F,$0F,$DE,$DE,$DE,$DE);
  4801. DMA_Lower_Page : DMAarray = ($87,$83,$81,$82,$00,$8B,$89,$8A);
  4802. DMA_Higher_Page : Array[0..7] of word
  4803. = ($487,$483,$481,$482,$0,$48B,$489,$48A);
  4804.  
  4805. { Modus Register DMA_Wr_mode_Reg }
  4806. Anforderungsmodus = $00;
  4807. Einzelmodus = $40;
  4808. Blockmodus = $80;
  4809. Kaskadierungsmodus = $C0;
  4810. Adressen_Decrement = $20;
  4811. Adressen_Increment = $00;
  4812. Autoinit_Enable = $10;
  4813. Autoinit_Disable = $00;
  4814. Pruef_transfer = $00;
  4815. Schreib_Transfer = $04;
  4816. Lese_Transfer = $08;
  4817.  
  4818. Set_Request_Bit = $04;
  4819. Clear_Request_Bit = $00;
  4820. Set_Mask_Bit = $04;
  4821. Clear_Mask_Bit = $00;
  4822.  
  4823. procedure DMA_Modus_setzen(Kanal,Modus : byte);
  4824. procedure DMA_NormModus_setzen(Kanal,Modus : byte);
  4825. procedure DMA_Clear_Flipflop(Kanal : byte);
  4826. procedure DMA_Startadresse(Kanal : byte; Start : pointer);
  4827. procedure DMA_Blockgroesse(Kanal : byte; size : word);
  4828. procedure DMA_Kanal_Einmaskieren(Kanal : byte);
  4829. procedure DMA_Kanal_Ausmaskieren(Kanal : byte);
  4830. procedure DMA_Init_Transfer(Kanal,Modus : byte; p : pointer; s : word);
  4831.  
  4832. implementation
  4833.  
  4834. TYPE
  4835. pt = record { erm”glicht die einfache }
  4836. ofs,sgm : word; { Behandlung von Pointern }
  4837. end;
  4838.  
  4839. procedure DMA_Modus_setzen(Kanal,Modus : byte);
  4840. begin;
  4841. port[DMAWr_Mode_Reg[Kanal]] := Modus;
  4842. end;
  4843.  
  4844. procedure DMA_NormModus_setzen(Kanal,Modus : byte);
  4845. begin;
  4846. port[DMAWr_Mode_Reg[Kanal]] := Modus+Adressen_Increment+Lese_Transfer+
  4847. Autoinit_Disable+Kanal;
  4848. end;
  4849.  
  4850. procedure DMA_Clear_Flipflop(Kanal : byte);
  4851. begin;
  4852. port[DMAClear_Flipflop[Kanal]] := 0;
  4853. end;
  4854.  
  4855. procedure DMA_Startadresse(Kanal : byte; Start : pointer);
  4856. var l : longint;
  4857. pn,offs : word;
  4858. begin;
  4859. l := 16*longint(pt(Start).sgm)+pt(Start).ofs;
  4860. pn := pt(l).sgm;
  4861. offs := pt(l).ofs;
  4862. port[DMA_Adress[Kanal]] := lo(offs);
  4863. port[DMA_Adress[Kanal]] := hi(offs);
  4864. port[DMA_Lower_Page[Kanal]] := lo(pn);
  4865. port[DMA_Higher_Page[Kanal]] := hi(pn);
  4866. end;
  4867.  
  4868. procedure DMA_Blockgroesse(Kanal : byte; size : word);
  4869. begin;
  4870. DMA_Clear_Flipflop(Kanal);
  4871. port[DMA_Count[Kanal]]:= lo(size);
  4872. port[DMA_Count[Kanal]] := hi(size);
  4873. end;
  4874.  
  4875. procedure DMA_Kanal_Einmaskieren(Kanal : byte);
  4876. begin;
  4877. port[DMAWr_single_mask_Reg[Kanal]] := Kanal + Set_Mask_Bit;
  4878. end;
  4879.  
  4880. procedure DMA_Kanal_Ausmaskieren(Kanal : byte);
  4881. begin;
  4882. port[DMAWr_single_mask_Reg[Kanal]] := Kanal + Clear_Mask_Bit;
  4883. end;
  4884.  
  4885. procedure DMA_Init_Transfer(Kanal,Modus : byte; p : pointer; s : word);
  4886. begin;
  4887. DMA_Kanal_Einmaskieren(Kanal);
  4888. DMA_Startadresse(Kanal,p);
  4889. DMA_Blockgroesse(Kanal,s);
  4890. DMA_NormModus_Setzen(Kanal,Modus+Kanal);
  4891. DMA_Kanal_Ausmaskieren(Kanal);
  4892. end;
  4893.  
  4894. begin;
  4895. end.
  4896.  
  4897.  
  4898.  
  4899.  
  4900.  
  4901.  
  4902.  
  4903.  
  4904. {
  4905. Beispiel fr den Einsatz der Unit "DMA".
  4906. }
  4907.  
  4908.  
  4909. [ ... ]
  4910.  
  4911.  
  4912. procedure Spiele_Sb16(dsize : word;p : pointer);
  4913. {
  4914. Bei Benutzung der Unit DMA ....
  4915. }
  4916. var li : word;
  4917. begin;
  4918. DMA_Init_Transfer(dma_ch,Blockmodus,p,dsize-1);
  4919.  
  4920. if sb16_outputlaenge <> dsize then begin;
  4921. wr_dsp_sb16($C6); { DSP-Befehl 8-Bit ber DMA }
  4922. if stereo then { fr SB16 Nur zum Starten ! }
  4923. wr_dsp_sb16($20)
  4924. else
  4925. wr_dsp_sb16($00);
  4926. wr_dsp_sb16(Lo(dsize-1)); { GrӇe des Blockes an }
  4927. wr_dsp_sb16(Hi(dsize-1)); { den DSP }
  4928. sb16_outputlaenge := dsize;
  4929. end else begin;
  4930. wr_dsp_sb16($45); { DMA Continue SB16 8-Bit }
  4931. end;
  4932. end;
  4933.  
  4934. [ ... ]
  4935.  
  4936. procedure Spiele_Sb16(Segm,Offs,dsize : word);
  4937. {
  4938. Ohne die Unit DMA ....
  4939. }
  4940. var li : word;
  4941. begin;
  4942. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  4943. Port[$0c] := 0; { Adresse des Puffers (blk) }
  4944. Port[$0B] := $49; { fr Soundausgabe }
  4945. {
  4946. Fehler im Sorce des Buches !!!!!!!!!!!!!!
  4947. muá
  4948. Port[$0B] := $48 + dma_ch;
  4949. heiáen !!!!!!!!!!!!!!!!!!!!
  4950. }
  4951. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  4952. Port[dma_adr[dma_ch]] := Hi(offs);
  4953. Port[dma_wc[dma_ch]] := Lo(dsize-1); { GrӇe des Blockes (block- }
  4954. Port[dma_wc[dma_ch]] := Hi(dsize-1); { groesse) an DMA-Controller }
  4955. Port[dma_page[dma_ch]] := Segm;
  4956. if sb16_outputlaenge <> dsize then begin;
  4957. wr_dsp_sb16($C6); { DSP-Befehl 8-Bit ber DMA }
  4958. if stereo then { fr SB16 Nur zum Starten ! }
  4959. wr_dsp_sb16($20)
  4960. else
  4961. wr_dsp_sb16($00);
  4962. wr_dsp_sb16(Lo(dsize-1)); { GrӇe des Blockes an }
  4963. wr_dsp_sb16(Hi(dsize-1)); { den DSP }
  4964. sb16_outputlaenge := dsize;
  4965. end else begin;
  4966. wr_dsp_sb16($45); { DMA Continue SB16 8-Bit }
  4967. end;
  4968. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  4969. end;
  4970.  
  4971. ;****************************************************************************
  4972. ;*** DATA BECKERs "PC UNDERGROUND" ***
  4973. ;*** ================================ ***
  4974. ;*** ***
  4975. ;*** Unit zur Nutzung des Flat-Modells ***
  4976. ;*** ***
  4977. ;*** Die Unit stellt Routinen zur Verfgung, mit der im Realmode auf den ***
  4978. ;*** gesamten Speicher des PC zugegriffen werden kann. ***
  4979. ;*** Es darf KEIN Memory-Manager wie EMM386 oder QEMM installiert sein. ***
  4980. ;*** HIMEM.SYS wird ben”tigt ! ***
  4981. ;*** ***
  4982. ;*** Autor : Boris Bertelsons (InspirE) ***
  4983. ;*** Dateiname : RMEM.PAS ***
  4984. ;*** Letzte Žnderung : 28.04.1994 ***
  4985. ;*** Version : 1.0 ***
  4986. ;*** Compiler : Turbo Pascal 6.0 und h”her ***
  4987. ;****************************************************************************
  4988.  
  4989. .386P
  4990. .model tpascal
  4991.  
  4992. .data
  4993. extrn GDT_Off : byte
  4994. extrn GDT : byte
  4995.  
  4996. .code
  4997. extrn xms_enable_a20 : far
  4998.  
  4999. public mem_lesen
  5000. public mem_Write
  5001. public Enable_4Giga
  5002. public Multitasker_aktiv
  5003.  
  5004.  
  5005. ;*************************************************************************
  5006. ;*** ***
  5007. ;*** Prft, ob ein Multitasker wie QEMM oder EMM386 aktiv ist ***
  5008. ;*** ***
  5009. ;*************************************************************************
  5010. Multitasker_aktiv proc pascal
  5011. mov eax,cr0
  5012. and ax,1
  5013. ret
  5014. Multitasker_aktiv endp
  5015.  
  5016. ;*************************************************************************
  5017. ;*** ***
  5018. ;*** Kopiert einen Block aus dem RMEM in den Hauptspeicher ***
  5019. ;*** ***
  5020. ;*************************************************************************
  5021. mem_Lesen proc pascal quellp:dword,zielofs : word,zielseg : word,laenge:word
  5022. call xms_Enable_A20
  5023. mov ax,zielseg ; Hauptspeicher-addy nach ES:SI
  5024. mov es,ax
  5025. mov di,zielofs
  5026. xor ax,ax ; RMEM Quelladresse nach GS:EAX
  5027. mov gs,ax
  5028. mov eax,quellp
  5029. mov cx,laenge
  5030. lloop: mov bl,byte ptr gs:[eax] ; Bytes kopieren
  5031. mov es:[di],bl
  5032. inc eax
  5033. inc di
  5034. loop lloop
  5035. ret
  5036. mem_Lesen endp
  5037.  
  5038.  
  5039. ;*************************************************************************
  5040. ;*** ***
  5041. ;*** Kopiert einen Block aus dem Hauptspeicher ins RMEM ***
  5042. ;*** ***
  5043. ;*************************************************************************
  5044.  
  5045. mem_Write proc pascal quellp:dword, zielofs:word, zielseg:word, laenge:word
  5046. call xms_Enable_A20
  5047. mov ax,zielseg ; Hauptspeicher-addy nach ES:SI
  5048. mov es,ax
  5049. mov di,zielofs
  5050. xor ax,ax ; RMEM Quelladresse nach GS:EAX
  5051. mov gs,ax
  5052. mov eax,quellp
  5053. mov cx,laenge
  5054. nloop:
  5055. mov bl,es:[di] ; Bytes kopieren
  5056. mov byte ptr gs:[eax],bl
  5057. inc eax
  5058. inc di
  5059. loop nloop
  5060. ret
  5061. mem_Write endp
  5062.  
  5063. ;*************************************************************************
  5064. ;*** ***
  5065. ;*** Schaltet den Processor ins Flat - Model ***
  5066. ;*** ***
  5067. ;*************************************************************************
  5068. Enable_4Giga proc pascal
  5069. mov GDT_Off[0],16
  5070. mov eax,seg GDT
  5071. shl eax,4
  5072. mov bx,offset GDT
  5073. movzx ebx,bx
  5074. add eax,ebx
  5075. mov dword ptr GDT_Off[2],eax
  5076. lgdt pword ptr GDT_Off ; GDT laden
  5077.  
  5078. mov bx,08h ; bx zeigt auf den 1. Eintrag des GDT
  5079. push ds
  5080. cli ; Interrupts ausschalten
  5081. mov eax,cr0 ; In den Protected mode schalten
  5082. or eax,1
  5083. mov cr0,eax
  5084. jmp In_den_Protectedmode ; Executionpipe l”schen
  5085. In_den_Protectedmode:
  5086. mov gs,bx ; Segmente auf 4 GB anpassen
  5087. mov fs,bx
  5088. mov es,bx
  5089. mov ds,bx
  5090. and al,0FEh ; Zurck in den Real-mode schalten, ohne den
  5091. mov cr0,eax ; Processor zu resetten
  5092. jmp In_den_Realmode ; Executionpipe l”schen
  5093. In_den_Realmode:
  5094. sti ; Interrupts wieder einschalten
  5095. pop ds
  5096. ret
  5097. Enable_4Giga endp
  5098.  
  5099. END
  5100.  
  5101. {
  5102.  
  5103. ****************************************************************************
  5104. *** DATA BECKERs "PC UNDERGROUND" ***
  5105. *** ================================ ***
  5106. *** ***
  5107. *** Demoprogramm zum Einsatz der Unit RMEM ***
  5108. *** ***
  5109. *** Das Programm demonstriert den Einsatz der Unit RMEM. ***
  5110. *** Ein Bild wird ins RMEM geladen, und dann aus dem RMEM angezeigt. ***
  5111. *** ***
  5112. *** Autor : Boris Bertelsons (InspirE) ***
  5113. *** Dateiname : DEMORMEM.PAS ***
  5114. *** Letzte Žnderung : 28.04.1994 ***
  5115. *** Version : 1.0 ***
  5116. *** Compiler : Turbo Pascal 6.0 und h”her ***
  5117. ****************************************************************************
  5118.  
  5119. }
  5120. program demo386;
  5121.  
  5122. uses dos,crt,rmem,gifunit;
  5123.  
  5124. var bildposition : longint;
  5125.  
  5126. procedure lade_das_gifbild;
  5127. begin;
  5128. getmem(vscreen,64000);
  5129. Init_ModeX;
  5130. blackpal;
  5131. LoadGif('beispiel.gif',vscreen,0,0);
  5132. textmode(3);
  5133. end;
  5134.  
  5135. procedure zeige_das_gifbild;
  5136. begin;
  5137. Init_ModeX;
  5138. p13_2_modex(0,16000);
  5139. setpal;
  5140. end;
  5141.  
  5142. begin
  5143. memory_checks(500,2700);
  5144. enable_Realmem(2700);
  5145.  
  5146. if not Rgetmem(bildposition,64000) then begin;
  5147. textmode(3);
  5148. writeln('Fehler beim Reservieren des Speichers !!!');
  5149. end;
  5150. lade_das_gifbild;
  5151.  
  5152. writeln('Habe das GIF-Bild in den Speicher geladen.');
  5153. writeln('Sichere nun das Bild ins RMEM und l”sche den Lade-Puffer !');
  5154. Rmem_write(vscreen,bildposition,64000);
  5155. fillchar(vscreen^,64000,0);
  5156.  
  5157. writeln('Habe den Lade-Puffer gel”scht !');
  5158. writeln('Lade nun das Bild aus dem RMEM');
  5159. writeln('<ENTER>, um das Bild anzuzeigen ... ');
  5160. readln;
  5161. Rmem_lesen(bildposition,vscreen,64000);
  5162. zeige_das_gifbild;
  5163.  
  5164. readln;
  5165. textmode(3);
  5166. Exit_Rmem;
  5167. end.
  5168.  
  5169. unit gifunit;
  5170.  
  5171. interface uses dos;
  5172.  
  5173. const clr=256; {gif}
  5174. eof=257;
  5175. pakt : byte = 0;
  5176. Const Maxsprites=14;
  5177. o_dtx=4; o_dty=6;
  5178. sampr : integer = 22;
  5179.  
  5180. var palette:Array[0..767] of Byte;
  5181. Var Handle:Word;
  5182. Puf:Array[0..767] of Byte;
  5183. PufInd:Word;
  5184. Stack:Array[0..1280] of byte;
  5185. ab_prfx,ab_tail:Array[0..4096] of word;
  5186. Byt:Byte;
  5187. free,breite,max,
  5188. stackp,restbits,restbyte,sonderfall,
  5189. code,old_code,readbyt,bits,bits2get:Word;
  5190. lbyte:Word;
  5191. mask:Word;
  5192. zseg,zofs,
  5193. GifName:String[15];
  5194. VScreen:Pointer;
  5195.  
  5196. Procedure LoadGif(name:String;var zielvar:Pointer;startadr:word;seek:Longint);
  5197. Procedure SetPal;
  5198. procedure Blackpal;
  5199. Procedure p13_2_modex(start,pic_size:word);
  5200. Procedure Split(row:byte);
  5201. Procedure Start(Ofst:Word);
  5202. Procedure Init_ModeX;
  5203. Procedure Init_Mode13;
  5204. Procedure WaitRetrace;
  5205.  
  5206. implementation
  5207.  
  5208. Procedure SetPal;assembler;
  5209. asm
  5210. mov si,offset palette
  5211. mov cx,256*3
  5212. xor al,al
  5213. mov dx,03c8h
  5214. out dx,al
  5215. inc dx
  5216. @lp:
  5217. rep outsb
  5218. End;
  5219.  
  5220. procedure Blackpal;
  5221. begin;
  5222. fillchar(palette,768,0);
  5223. setpal;
  5224. end;
  5225.  
  5226. Procedure GifOpen;assembler;
  5227. asm
  5228. mov ax,03d00h
  5229. lea dx,gifname + 1
  5230. int 21h
  5231. mov handle,ax
  5232. End;
  5233. Procedure GifRead(n:Word);assembler;
  5234. asm
  5235. mov ax,03f00h
  5236. mov bx,handle
  5237. mov cx,n
  5238. lea dx,puf
  5239. int 21h
  5240. end;
  5241. Procedure GifSeekdelta(delta:Longint);assembler;
  5242. asm
  5243. mov ax,04200h
  5244. mov bx,handle
  5245. mov cx,word ptr delta + 2
  5246. mov dx,word ptr delta
  5247. int 21h
  5248. End;
  5249. Procedure GifClose;Assembler;
  5250. asm
  5251. mov ax,03e00h
  5252. mov bx,handle
  5253. int 21h
  5254. End;
  5255. Procedure ShiftPal;assembler;
  5256. asm
  5257. push ds
  5258. pop es
  5259. mov si,offset Puf
  5260. mov di,offset Palette
  5261. mov cx,768
  5262. @l1:
  5263. lodsb
  5264. shr al,2
  5265. stosb
  5266. loop @l1
  5267. End;
  5268. Procedure FillPuf;
  5269. Begin
  5270. GifRead(1);
  5271. restbyte:=puf[0];
  5272. GifRead(restbyte);
  5273. End;
  5274.  
  5275. Function GetPhysByte:Byte;assembler;
  5276. asm
  5277. push bx
  5278. cmp restbyte,0
  5279. ja @restda
  5280. pusha
  5281. call fillpuf
  5282. popa
  5283. mov pufind,0
  5284. @restda:
  5285. mov bx,PufInd
  5286. mov al,byte ptr Puf[bx]
  5287. inc pufind
  5288. pop bx
  5289. End;
  5290.  
  5291. Function GetLogByte:Word;assembler;
  5292. asm
  5293. push si
  5294. mov ax,breite
  5295. mov si,ax
  5296. mov dx,restbits
  5297. mov cx,8
  5298. sub cx,dx
  5299. mov ax,lByte
  5300. shr ax,cl
  5301. mov code,ax
  5302. sub si,dx
  5303. @nextbyte:
  5304. call getphysbyte
  5305. xor ah,ah
  5306. mov lByte,ax
  5307. dec restbyte
  5308.  
  5309. mov bx,1
  5310. mov cx,si
  5311. shl bx,cl
  5312. dec bx
  5313. and ax,bx
  5314.  
  5315. mov cx,dx
  5316. shl ax,cl
  5317. add code,ax
  5318.  
  5319. sbb dx,breite
  5320. add dx,8
  5321. jns @positiv
  5322. add dx,8
  5323. @positiv:
  5324. sub si,8
  5325. jle @fertig { <= 0 }
  5326. add dx,breite
  5327. sub dx,8
  5328. jmp @nextbyte
  5329. @fertig:
  5330. mov restbits,dx
  5331. mov ax,code
  5332. pop si
  5333. End;
  5334.  
  5335. Procedure p13_2_modex(start,pic_size:word);assembler;
  5336. Var Plane_l:Byte;
  5337. Plane_Pos:Word;
  5338. asm
  5339. mov plane_l,1
  5340. mov plane_pos,0
  5341. push ds
  5342. lds si,vscreen
  5343. mov plane_pos,si
  5344. mov ax,0a000h
  5345. mov es,ax
  5346. mov di,start
  5347. mov cx,pic_size
  5348. @lpplane:
  5349. mov al,02h
  5350. mov ah,plane_l
  5351. mov dx,3c4h
  5352. out dx,ax
  5353.  
  5354. @lp1:
  5355. movsb
  5356. add si,3
  5357. loop @lp1
  5358. { dec cx
  5359. jne @lp1}
  5360.  
  5361.  
  5362. mov di,start
  5363. inc plane_pos
  5364. mov si,plane_pos
  5365. mov cx,pic_size
  5366. shl plane_l,1
  5367. cmp plane_l,10h
  5368. jne @lpplane
  5369.  
  5370. pop ds
  5371. End;
  5372.  
  5373. Procedure LoadGif(name:String;var zielvar:Pointer;startadr:word;seek:Longint);
  5374. Var ziel,
  5375. quelle,qseg:Word;
  5376. { pic_size,pic_height,pic_width:word;}
  5377. x_count:Word;
  5378. zielvarlok:Pointer;
  5379. Begin
  5380. gifName:=Name+#0;
  5381. if zielvar = Nil Then
  5382. getMem(zielvar,64000);
  5383. GifOpen;
  5384. gifseekdelta(seek+13);
  5385. gifread(768);
  5386. Shiftpal;
  5387. gifread(1);
  5388. While Puf[0] = $21 do Begin {Erw - Block berlesen}
  5389. gifread(2);
  5390. gifread(puf[1]+1);
  5391. End;
  5392. GifRead(10);
  5393. { pic_width:=puf[4]+puf[5]*256;
  5394. pic_height:=puf[6]+puf[7]*256;
  5395. pic_size:=pic_width div 4 * pic_height;}
  5396. If Puf[8] and 128 = 128 Then Begin
  5397. gifread(768);
  5398. Shiftpal;
  5399. End;
  5400. lByte:=0;
  5401. Zielvarlok:=Zielvar;
  5402. asm
  5403. les di,zielvarlok
  5404.  
  5405. mov free,258 {1. freie Posit in Alphabet}
  5406. mov breite,9 {Zeichenbreite in bit}
  5407. mov max,511 {maximaler darstellbarer Wert bei akt breite}
  5408. mov stackp,0
  5409. mov restbits,0
  5410. mov restbyte,0
  5411. @mainloop:
  5412. call getlogByte
  5413. cmp ax,eof
  5414. je @abbruch
  5415. cmp ax,clr
  5416. je @clear
  5417. mov readbyt,ax
  5418. cmp ax,free
  5419. jb @code_in_ab
  5420. mov ax,old_code
  5421. mov code,ax
  5422. mov bx,stackp
  5423. mov cx,sonderfall
  5424. mov word ptr stack[bx],cx
  5425. inc stackp
  5426. @code_in_ab:
  5427. cmp ax,clr
  5428. jb @konkret
  5429. @fillstack_loop:
  5430. mov bx,code
  5431. shl bx,1
  5432. push bx
  5433. mov ax,word ptr ab_tail[bx]
  5434. mov bx,stackp
  5435. shl bx,1
  5436. mov word ptr stack[bx],ax
  5437. inc stackp
  5438. pop bx
  5439. mov ax,word ptr ab_prfx[bx]
  5440. mov code,ax
  5441. cmp ax,clr
  5442. ja @fillstack_loop
  5443. @konkret:
  5444. mov bx,stackp
  5445. shl bx,1
  5446. mov word ptr stack[bx],ax
  5447. mov sonderfall,ax
  5448. inc stackp
  5449. mov bx,stackp
  5450. dec bx
  5451. shl bx,1
  5452. @readstack_loop:
  5453. mov ax,word ptr stack[bx]
  5454.  
  5455. stosb
  5456. or di,di
  5457. jne @noovl1
  5458. push startadr
  5459. push 16384
  5460. add startadr,16384
  5461. call p13_2_modex
  5462. les di,zielvarlok
  5463.  
  5464. @noovl1:
  5465. { add si,4
  5466. and si,12
  5467. or di,di
  5468. jne @rsnc
  5469. mov ax,es
  5470. add ax,1000h
  5471. mov es,ax
  5472. @rsnc:}
  5473. dec bx
  5474. dec bx
  5475. jns @readstack_loop
  5476. mov stackp,0
  5477. mov bx,free
  5478. shl bx,1
  5479. mov ax,old_code
  5480. mov word ptr ab_prfx[bx],ax
  5481. mov ax,code
  5482. mov word ptr ab_tail[bx],ax
  5483. mov ax,readbyt
  5484. mov old_code,ax
  5485. inc free
  5486. mov ax,free
  5487. cmp ax,max
  5488. jbe @mainloop
  5489. cmp byte ptr breite,12
  5490. jae @mainloop
  5491. inc breite
  5492. mov cl,byte ptr breite
  5493. mov ax,1
  5494. shl ax,cl
  5495. dec ax
  5496. mov max,ax
  5497. jmp @mainloop
  5498. @clear:
  5499. mov breite,9
  5500. mov max,511
  5501. mov free,258
  5502. call getlogbyte
  5503. mov sonderfall,ax
  5504. mov old_code,ax
  5505.  
  5506. stosb
  5507. or di,di
  5508. jne @noovl2
  5509. push startadr
  5510. push 16384
  5511. add startadr,16384
  5512. call p13_2_modex
  5513. les di,zielvarlok
  5514.  
  5515. @noovl2:
  5516. { add si,4
  5517. and si,12
  5518.  
  5519. or di,di
  5520. jne @mainloop
  5521. mov ax,es
  5522. add ax,1000h
  5523. mov es,ax }
  5524.  
  5525. jmp @mainloop
  5526. @abbruch:
  5527. End;
  5528. gifclose;
  5529. End;
  5530.  
  5531. procedure disable4; assembler;
  5532. asm;
  5533. mov dx,3c4h
  5534. mov ax,0f02h
  5535. out dx,ax
  5536.  
  5537. mov dx,3ceh
  5538. mov ax,4005h
  5539. out dx,ax
  5540. end;
  5541.  
  5542. Procedure ShowPic;assembler;
  5543. asm
  5544. push ds
  5545. mov di,0a000h
  5546. mov es,di
  5547. xor di,di
  5548. mov si,word ptr VScreen
  5549. mov ax,word ptr Vscreen + 2
  5550. mov ds,ax
  5551. mov cx,32000
  5552. rep movsw
  5553. pop ds
  5554. End;
  5555. Procedure ClearPic(Size:Word);assembler;
  5556. asm
  5557. mov ax,word ptr vscreen + 2
  5558. mov es,ax
  5559. mov di,word ptr vscreen
  5560. mov cx,Size
  5561. xor ax,ax
  5562. rep stosw
  5563. End;
  5564.  
  5565. Procedure WaitRetrace;assembler;
  5566. asm
  5567. mov dx,3dah
  5568. @wait1:
  5569. in al,dx
  5570. test al,8h
  5571. jz @wait1
  5572. @wait2:
  5573. in al,dx
  5574. test al,8h
  5575. jnz @wait2
  5576. End;
  5577.  
  5578. Procedure Init_Mode13;assembler;
  5579. asm
  5580. mov ax,13h
  5581. int 10h
  5582. End;
  5583.  
  5584. Procedure Init_ModeX;assembler;
  5585. asm
  5586. mov ax,0013h { Den normalen Mode 13h setzen }
  5587. int 10h
  5588.  
  5589. mov dx,3c4h { Verknpfung aufheben, Einzelzugriff }
  5590. mov al,4 { erm”glichen }
  5591. out dx,al
  5592. inc dx
  5593. in al,dx
  5594. and al,0f7h
  5595. or al,4h
  5596. out dx,al
  5597. dec dx
  5598. mov ax,0f02h
  5599. out dx,ax
  5600.  
  5601. mov ax,0a000h { Bildschirmspeicher l”schen }
  5602. mov es,ax
  5603. xor di,di
  5604. xor ax,ax
  5605. mov cx,8000h
  5606. cld
  5607. rep stosw
  5608.  
  5609. mov dx,3d4h
  5610. mov al,14h
  5611. out dx,al
  5612. inc dx
  5613. in al,dx
  5614. and al,0bfh
  5615. out dx,al
  5616. dec dx
  5617. mov al,17h
  5618. out dx,al
  5619. inc dx
  5620. in al,dx
  5621. or al,40h
  5622. out dx,al
  5623. End;
  5624.  
  5625. Procedure Start(Ofst:Word);assembler;
  5626. asm
  5627. mov dx,3d4h
  5628. mov al,0ch
  5629. mov ah,byte ptr ofst + 1
  5630. out dx,ax
  5631. inc al
  5632. mov ah,byte ptr ofst
  5633. out dx,ax
  5634. End;
  5635.  
  5636. Procedure Split(row:byte);assembler;
  5637. asm
  5638. mov bl,row
  5639. xor bh,bh
  5640. shl bx,1
  5641. mov cx,bx
  5642.  
  5643. mov dx,3d4h
  5644. mov al,07h
  5645. out dx,al
  5646. inc dx
  5647. in al,dx
  5648. and al,11101111b
  5649. shr cx,4
  5650. and cl,16
  5651. or al,cl
  5652. out dx,al
  5653.  
  5654. dec dx
  5655. mov al,09h
  5656. out dx,al
  5657. inc dx
  5658. in al,dx
  5659. and al,10111111b
  5660. shr bl,3
  5661. and bl,64
  5662. or al,bl
  5663. out dx,al
  5664.  
  5665. dec dx
  5666. mov al,18h
  5667. mov ah,row
  5668. shl ah,1
  5669. out dx,ax
  5670. End;
  5671.  
  5672. Procedure enable4;assembler;
  5673. asm
  5674. mov dx,3c4h
  5675. mov ax,0f02h
  5676. out dx,ax
  5677.  
  5678. mov dx,3ceh
  5679. mov ax,4105h
  5680. out dx,ax
  5681. End;
  5682.  
  5683.  
  5684. begin;
  5685. end.{
  5686.  
  5687. ****************************************************************************
  5688. *** DATA BECKERs "PC UNDERGROUND" ***
  5689. *** ================================ ***
  5690. *** ***
  5691. *** Unit zur Nutzung des Flat-Modells ***
  5692. *** ***
  5693. *** Die Unit stellt Routinen zur Verfgung, mit der im Realmode auf den ***
  5694. *** gesamten Speicher des PC zugegriffen werden kann. ***
  5695. *** Es darf KEIN Memory-Manager wie EMM386 oder QEMM installiert sein. ***
  5696. *** HIMEM.SYS wird ben”tigt ! ***
  5697. *** ***
  5698. *** Autor : Boris Bertelsons (InspirE) ***
  5699. *** Dateiname : RMEM.PAS ***
  5700. *** Letzte Žnderung : 28.04.1994 ***
  5701. *** Version : 1.0 ***
  5702. *** Compiler : Turbo Pascal 6.0 und h”her ***
  5703. ****************************************************************************
  5704.  
  5705. }
  5706. unit rmem;
  5707. interface
  5708.  
  5709. uses crt;
  5710.  
  5711. const Rmem_Max : longint = 3*1024*1024-70000;
  5712.  
  5713. const GDT : array[1..16] of byte =(
  5714. $00,$00,$00,$00,$00,$00,$00,$00, {GDT Eintrag 0 (null segment)}
  5715. $FF,$FF,$00,$00,$00,$92,$CF,$FF); {GDT Eintrag 1 (seg 0, limit 4GB)}
  5716.  
  5717. var GDT_Off : array[1..6] of byte;
  5718.  
  5719. procedure memory_checks(minmain,minxms : word);
  5720. procedure enable_Realmem(Min : word);
  5721. procedure Exit_Rmem;
  5722.  
  5723. function Rgetmem(Var rpos : longint;rsize : longint) : boolean;
  5724. procedure Rmem_Lesen(quelle:longint; ziel:pointer;laenge:word);
  5725. procedure Rmem_write(quelle:pointer;ziel:longint;laenge:word);
  5726.  
  5727.  
  5728. implementation
  5729.  
  5730. uses dos;
  5731.  
  5732. TYPE XMSHandle = word;
  5733.  
  5734. XMS_Copyblock = Record { Wird fr die Kopier-Routinen ben”tigt }
  5735. Size : longint;
  5736. Q_Handle : Word;
  5737. Q_Offset : pointer;
  5738. Z_Handle : Word;
  5739. Z_Offset : pointer;
  5740. end;
  5741.  
  5742. VAR XMS_Vorhanden : boolean; { TRUE, wenn XMS vorhanden ist }
  5743. XMST : pointer; { Treiber - Einsprungadresse }
  5744. XMS_Version : word; { Die Version des XMS-Treibers }
  5745. XC : XMS_Copyblock;
  5746. xms_frei : longint;
  5747. error : byte;
  5748. My_XmsHandle : XmsHandle;
  5749. Xms_startposi : longint;
  5750. Old_ExitprocRmem : pointer;
  5751.  
  5752.  
  5753. function XMS_free : longint;
  5754. var xms_in_kb : word;
  5755. xms_long: longint;
  5756. begin;
  5757. asm
  5758. mov ax,0800h { 8 = Freien Speicher Ermitteln }
  5759. call dword ptr [XMST]
  5760. mov xms_in_kb,dx
  5761. end;
  5762. xms_long := xms_in_kb;
  5763. XMS_free := xms_long * 1024;
  5764. end;
  5765.  
  5766. Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
  5767. var bsize : word;
  5768. Fresult : byte;
  5769. xmsh : word;
  5770. begin;
  5771. bsize := (size DIV 1024) + 1;
  5772. asm
  5773. mov ax,0900h { 9 = Speicherbereich allocieren }
  5774. mov dx,bsize
  5775. call dword ptr [XMST]
  5776. cmp ax,1
  5777. jne @Fehler_GetmemXms
  5778. mov xmsh,dx
  5779. mov Fresult,0
  5780. jmp @Ende_GetmemXms
  5781. @Fehler_GetmemXMS:
  5782. mov Fresult,bl
  5783. @Ende_GetmemXms:
  5784. end;
  5785. h := xmsh;
  5786. Getmem_Xms := Fresult;
  5787. end;
  5788.  
  5789. Function Freemem_XMS(H : XMSHandle) : byte;
  5790. var fresult : byte;
  5791. begin;
  5792. asm { A = Speicherbereich deallocieren }
  5793. mov ax,0a00h
  5794. mov dx,h
  5795. call dword ptr [XMST]
  5796. cmp ax,1
  5797. jne @Fehler_FreememXms
  5798. mov Fresult,0
  5799. jmp @Ende_FreememXms
  5800. @Fehler_FreememXms:
  5801. mov Fresult,bl
  5802. @Ende_FreememXms:
  5803. end;
  5804. end;
  5805.  
  5806. Procedure Check_for_XMS; assembler;
  5807. asm
  5808. mov ax,4300h { Prfen, ob Treiber Installiert }
  5809. int 2Fh
  5810. cmp al,80h
  5811. jne @Kein_XMSTreiber
  5812. mov ax,4310h { Einsprungadresse des Treibers ermitteln }
  5813. int 2Fh
  5814. mov word ptr XMST + 2,es
  5815. mov word ptr XMST + 0,bx
  5816. xor ax,ax { Versionsnummer ermitteln }
  5817. call dword ptr [XMST]
  5818. cmp ax,0200h
  5819. jb @Kein_XMSTreiber { Wenn Version < 2.0 dann Abbrechen ! }
  5820. mov XMS_Version,ax
  5821. mov XMS_Vorhanden,0
  5822. @Kein_XMSTreiber:
  5823. mov XMS_Vorhanden,1
  5824. @Ende_XMS_Check:
  5825. end;
  5826.  
  5827. function XMS_lock(H : XMSHandle) : longint; assembler;
  5828. asm;
  5829. mov ax,0c00h
  5830. mov dx,h
  5831. call dword ptr [XMST]
  5832. mov ax,bx
  5833. end;
  5834.  
  5835. procedure XMS_unlock(H : XMSHandle); assembler;
  5836. asm;
  5837. mov ax,0d00h
  5838. mov dx,h
  5839. call dword ptr [XMST]
  5840. end;
  5841.  
  5842. procedure XMS_Enable_A20; assembler;
  5843. asm
  5844. mov ax,0500h
  5845. call dword ptr [XMST]
  5846. end;
  5847.  
  5848. procedure XMS_Disable_A20; assembler;
  5849. asm
  5850. mov ax,0600h
  5851. call dword ptr [XMST]
  5852. end;
  5853.  
  5854.  
  5855. const MByte1: longint = $100000;
  5856.  
  5857. var Offs,Segm : word;
  5858. Rmemposi : longint;
  5859.  
  5860. {$l rmemasm.obj}
  5861. procedure mem_write(q:longint;zl,zh,l:word); far; external;
  5862. {
  5863. *************************************************************************
  5864. *** ***
  5865. *** Kopiert einen Block aus dem Hauptspeicher ins RMEM ***
  5866. *** ***
  5867. *************************************************************************
  5868. }
  5869.  
  5870. procedure mem_lesen(q:longint;zl,zh,l:word); far; external;
  5871. {
  5872. *************************************************************************
  5873. *** ***
  5874. *** Kopiert einen Block aus dem RMEM in den Hauptspeicher ***
  5875. *** ***
  5876. *************************************************************************
  5877. }
  5878.  
  5879. procedure Enable_4Giga; far; external;
  5880. {
  5881. *************************************************************************
  5882. *** ***
  5883. *** Schaltet den Processor ins Flat - Model ***
  5884. *** ***
  5885. *************************************************************************
  5886. }
  5887.  
  5888. function multitasker_aktiv : boolean; far; external;
  5889. {
  5890. *************************************************************************
  5891. *** ***
  5892. *** Prft, ob ein Multitasker wie QEMM oder EMM386 aktiv ist ***
  5893. *** ***
  5894. *************************************************************************
  5895. }
  5896.  
  5897. procedure Rmem_Lesen(quelle:longint; ziel:pointer;laenge:word);
  5898. {
  5899. *************************************************************************
  5900. *** ***
  5901. *** Kopiert einen Block aus dem RMEM in den Hauptspeicher ***
  5902. *** ***
  5903. *************************************************************************
  5904. }
  5905. begin
  5906. if quelle + laenge < Rmem_Max then begin
  5907. Segm:=seg(ziel^);
  5908. Offs:=ofs(ziel^);
  5909. inc(Segm,Offs div 16);
  5910. Offs:=Offs mod 16;
  5911. inc(quelle,MByte1);
  5912. mem_lesen(quelle,Offs,Segm,laenge);
  5913. end else begin;
  5914. asm mov ax,0003; int 10h; end;
  5915. writeln('Error reading back XMS Realmemory !');
  5916. writeln('System halted');
  5917. halt(0);
  5918. end;
  5919. end;
  5920.  
  5921. procedure Rmem_write(quelle:pointer;ziel:longint;laenge:word);
  5922. {
  5923. *************************************************************************
  5924. *** ***
  5925. *** Kopiert einen Block aus dem Hauptspeicher ins RMEM ***
  5926. *** ***
  5927. *************************************************************************
  5928. }
  5929. begin
  5930. if ziel+laenge < Rmem_Max then begin
  5931. Segm := seg(quelle^);
  5932. Offs := ofs(quelle^);
  5933. inc(Segm,Offs div 16);
  5934. Offs := Offs mod 16;
  5935. inc(ziel,MByte1);
  5936. mem_write(ziel, Offs,Segm,laenge);
  5937. end else begin;
  5938. asm mov ax,0003; int 10h; end;
  5939. writeln('XMS allocation error ! Not enough memory ?');
  5940. writeln('System halted');
  5941. halt(0);
  5942. end;
  5943. end;
  5944.  
  5945. procedure memory_checks(minmain,minxms : word);
  5946. {
  5947. *************************************************************************
  5948. *** ***
  5949. *** Prft, ob gengend Speicher zur Verfgung steht ***
  5950. *** ***
  5951. *************************************************************************
  5952. }
  5953. var xmsfree,mainfree : word;
  5954. begin;
  5955. { Freien XMS - Speicher ermitteln }
  5956. xmsfree := xms_free;
  5957. { Hauptspeicher ermitteln }
  5958. mainfree := memavail div 1024;
  5959. { Meldung, wenn nicht genug ferier Speicher }
  5960. if (xmsfree < minxms) or (mainfree < minmain) then begin;
  5961. asm mov ax,0003; int 10h; end;
  5962. writeln('Sorry, not enough memory available !');
  5963. writeln(' You need Available');
  5964. writeln('XMS : ',minxms :6,' KB ',xmsfree:4,' KB');
  5965. writeln('Main: ',minmain:6,' KB ',mainfree:4,' KB');
  5966. halt(0);
  5967. end;
  5968. end;
  5969.  
  5970. function Rgetmem(Var rpos : longint;rsize : longint) : boolean;
  5971. {
  5972. *************************************************************************
  5973. *** ***
  5974. *** Eine vereinfachte Getmem-Procedure fr das RMEM ***
  5975. *** ***
  5976. *************************************************************************
  5977. }
  5978. begin;
  5979. if Rmemposi+rsize > Rmem_max then begin;
  5980. Rgetmem := false;
  5981. end else begin;
  5982. rpos := Rmemposi;
  5983. inc(Rmemposi,rsize);
  5984. Rgetmem := true;
  5985. end;
  5986. end;
  5987.  
  5988. procedure Exit_Rmem;
  5989. {
  5990. *************************************************************************
  5991. *** ***
  5992. *** Exit-Procedure des RMEM, MUSS aufgerufen werden ! ***
  5993. *** ***
  5994. *************************************************************************
  5995. }
  5996. begin;
  5997. { Block entsperren }
  5998. XMS_unlock(My_XmsHandle);
  5999. { Speicher freigeben }
  6000. Freemem_XMS(My_XmsHandle);
  6001. end;
  6002.  
  6003. procedure enable_Realmem(Min : word);
  6004. {
  6005. *************************************************************************
  6006. *** ***
  6007. *** Schaltet in den RMEM - Modus ***
  6008. *** Es muá "MIN" KB freier XMS-Speicher vorhanden sein ! ***
  6009. *** ***
  6010. *************************************************************************
  6011. }
  6012. begin
  6013. { Auf Multitasker prfen ... }
  6014. if multitasker_aktiv then begin;
  6015. asm mov ax,0003; int 10h; end;
  6016. writeln('Processor already in V86 mode !');
  6017. writeln('Please reboot without any EMS-drivers such as EMM386, QEMM etc.');
  6018. writeln('HIMEM.SYS is required ! ');
  6019. halt(0);
  6020. end;
  6021. { XMS Treiber installiert ? }
  6022. if not XMS_Vorhanden then begin;
  6023. asm mov ax,0003; int 10h; end;
  6024. writeln('No XMS or Himem-driver available');
  6025. writeln('Please reboot your System using HIMEM.SYS !!!');
  6026. halt(0);
  6027. end;
  6028. { Ben”tigten Speicher belegen }
  6029. error := Getmem_XMS(My_XmsHandle,min*1024);
  6030. if error <> 0 then begin;
  6031. asm mov ax,0003; int 10h; end;
  6032. writeln('Error during memory-allocation !');
  6033. writeln('We need at least ',Min,' KB of free XMS Memory !!!');
  6034. writeln('Please reboot your System using HIMEM.SYS');
  6035. writeln;
  6036. halt(0);
  6037. end;
  6038. { Physikalische Startposition ermitteln }
  6039. Rmemposi := XMS_lock(My_XmsHandle);
  6040. if rmemposi < 1000000 then begin;
  6041. asm mov ax,0003; int 10h; end;
  6042. writeln('Error during memory-fixing !');
  6043. writeln('We need at least ',Min,' KB of free XMS Memory !!!');
  6044. writeln('Please reboot your System using HIMEM.SYS');
  6045. writeln;
  6046. halt(0);
  6047. end;
  6048. { Freischalten }
  6049. Enable_4Giga;
  6050. end;
  6051.  
  6052. begin;
  6053. Check_for_XMS;
  6054. Rmem_Max := XMS_Free;
  6055. end.
  6056. unit gifunit;
  6057.  
  6058. interface uses dos;
  6059.  
  6060. const clr=256; {gif}
  6061. eof=257;
  6062. pakt : byte = 0;
  6063. Const Maxsprites=14;
  6064. o_dtx=4; o_dty=6;
  6065. sampr : integer = 22;
  6066.  
  6067. var palette:Array[0..767] of Byte;
  6068. Var Handle:Word;
  6069. Puf:Array[0..767] of Byte;
  6070. PufInd:Word;
  6071. Stack:Array[0..1280] of byte;
  6072. ab_prfx,ab_tail:Array[0..4096] of word;
  6073. Byt:Byte;
  6074. free,breite,max,
  6075. stackp,restbits,restbyte,sonderfall,
  6076. code,old_code,readbyt,bits,bits2get:Word;
  6077. lbyte:Word;
  6078. mask:Word;
  6079. zseg,zofs,
  6080. GifName:String[15];
  6081. VScreen:Pointer;
  6082.  
  6083. Procedure LoadGif(name:String;var zielvar:Pointer;startadr:word;seek:Longint);
  6084. Procedure SetPal;
  6085. procedure Blackpal;
  6086. Procedure p13_2_modex(start,pic_size:word);
  6087. Procedure Split(row:byte);
  6088. Procedure Start(Ofst:Word);
  6089. Procedure Init_ModeX;
  6090. Procedure Init_Mode13;
  6091. Procedure WaitRetrace;
  6092.  
  6093. implementation
  6094.  
  6095. Procedure SetPal;assembler;
  6096. asm
  6097. mov si,offset palette
  6098. mov cx,256*3
  6099. xor al,al
  6100. mov dx,03c8h
  6101. out dx,al
  6102. inc dx
  6103. @lp:
  6104. rep outsb
  6105. End;
  6106.  
  6107. procedure Blackpal;
  6108. begin;
  6109. fillchar(palette,768,0);
  6110. setpal;
  6111. end;
  6112.  
  6113. Procedure GifOpen;assembler;
  6114. asm
  6115. mov ax,03d00h
  6116. lea dx,gifname + 1
  6117. int 21h
  6118. mov handle,ax
  6119. End;
  6120. Procedure GifRead(n:Word);assembler;
  6121. asm
  6122. mov ax,03f00h
  6123. mov bx,handle
  6124. mov cx,n
  6125. lea dx,puf
  6126. int 21h
  6127. end;
  6128. Procedure GifSeekdelta(delta:Longint);assembler;
  6129. asm
  6130. mov ax,04200h
  6131. mov bx,handle
  6132. mov cx,word ptr delta + 2
  6133. mov dx,word ptr delta
  6134. int 21h
  6135. End;
  6136. Procedure GifClose;Assembler;
  6137. asm
  6138. mov ax,03e00h
  6139. mov bx,handle
  6140. int 21h
  6141. End;
  6142. Procedure ShiftPal;assembler;
  6143. asm
  6144. push ds
  6145. pop es
  6146. mov si,offset Puf
  6147. mov di,offset Palette
  6148. mov cx,768
  6149. @l1:
  6150. lodsb
  6151. shr al,2
  6152. stosb
  6153. loop @l1
  6154. End;
  6155. Procedure FillPuf;
  6156. Begin
  6157. GifRead(1);
  6158. restbyte:=puf[0];
  6159. GifRead(restbyte);
  6160. End;
  6161.  
  6162. Function GetPhysByte:Byte;assembler;
  6163. asm
  6164. push bx
  6165. cmp restbyte,0
  6166. ja @restda
  6167. pusha
  6168. call fillpuf
  6169. popa
  6170. mov pufind,0
  6171. @restda:
  6172. mov bx,PufInd
  6173. mov al,byte ptr Puf[bx]
  6174. inc pufind
  6175. pop bx
  6176. End;
  6177.  
  6178. Function GetLogByte:Word;assembler;
  6179. asm
  6180. push si
  6181. mov ax,breite
  6182. mov si,ax
  6183. mov dx,restbits
  6184. mov cx,8
  6185. sub cx,dx
  6186. mov ax,lByte
  6187. shr ax,cl
  6188. mov code,ax
  6189. sub si,dx
  6190. @nextbyte:
  6191. call getphysbyte
  6192. xor ah,ah
  6193. mov lByte,ax
  6194. dec restbyte
  6195.  
  6196. mov bx,1
  6197. mov cx,si
  6198. shl bx,cl
  6199. dec bx
  6200. and ax,bx
  6201.  
  6202. mov cx,dx
  6203. shl ax,cl
  6204. add code,ax
  6205.  
  6206. sbb dx,breite
  6207. add dx,8
  6208. jns @positiv
  6209. add dx,8
  6210. @positiv:
  6211. sub si,8
  6212. jle @fertig { <= 0 }
  6213. add dx,breite
  6214. sub dx,8
  6215. jmp @nextbyte
  6216. @fertig:
  6217. mov restbits,dx
  6218. mov ax,code
  6219. pop si
  6220. End;
  6221.  
  6222. Procedure p13_2_modex(start,pic_size:word);assembler;
  6223. Var Plane_l:Byte;
  6224. Plane_Pos:Word;
  6225. asm
  6226. mov plane_l,1
  6227. mov plane_pos,0
  6228. push ds
  6229. lds si,vscreen
  6230. mov plane_pos,si
  6231. mov ax,0a000h
  6232. mov es,ax
  6233. mov di,start
  6234. mov cx,pic_size
  6235. @lpplane:
  6236. mov al,02h
  6237. mov ah,plane_l
  6238. mov dx,3c4h
  6239. out dx,ax
  6240.  
  6241. @lp1:
  6242. movsb
  6243. add si,3
  6244. loop @lp1
  6245. { dec cx
  6246. jne @lp1}
  6247.  
  6248.  
  6249. mov di,start
  6250. inc plane_pos
  6251. mov si,plane_pos
  6252. mov cx,pic_size
  6253. shl plane_l,1
  6254. cmp plane_l,10h
  6255. jne @lpplane
  6256.  
  6257. pop ds
  6258. End;
  6259.  
  6260. Procedure LoadGif(name:String;var zielvar:Pointer;startadr:word;seek:Longint);
  6261. Var ziel,
  6262. quelle,qseg:Word;
  6263. { pic_size,pic_height,pic_width:word;}
  6264. x_count:Word;
  6265. zielvarlok:Pointer;
  6266. Begin
  6267. gifName:=Name+#0;
  6268. if zielvar = Nil Then
  6269. getMem(zielvar,64000);
  6270. GifOpen;
  6271. gifseekdelta(seek+13);
  6272. gifread(768);
  6273. Shiftpal;
  6274. gifread(1);
  6275. While Puf[0] = $21 do Begin {Erw - Block berlesen}
  6276. gifread(2);
  6277. gifread(puf[1]+1);
  6278. End;
  6279. GifRead(10);
  6280. { pic_width:=puf[4]+puf[5]*256;
  6281. pic_height:=puf[6]+puf[7]*256;
  6282. pic_size:=pic_width div 4 * pic_height;}
  6283. If Puf[8] and 128 = 128 Then Begin
  6284. gifread(768);
  6285. Shiftpal;
  6286. End;
  6287. lByte:=0;
  6288. Zielvarlok:=Zielvar;
  6289. asm
  6290. les di,zielvarlok
  6291.  
  6292. mov free,258 {1. freie Posit in Alphabet}
  6293. mov breite,9 {Zeichenbreite in bit}
  6294. mov max,511 {maximaler darstellbarer Wert bei akt breite}
  6295. mov stackp,0
  6296. mov restbits,0
  6297. mov restbyte,0
  6298. @mainloop:
  6299. call getlogByte
  6300. cmp ax,eof
  6301. je @abbruch
  6302. cmp ax,clr
  6303. je @clear
  6304. mov readbyt,ax
  6305. cmp ax,free
  6306. jb @code_in_ab
  6307. mov ax,old_code
  6308. mov code,ax
  6309. mov bx,stackp
  6310. mov cx,sonderfall
  6311. mov word ptr stack[bx],cx
  6312. inc stackp
  6313. @code_in_ab:
  6314. cmp ax,clr
  6315. jb @konkret
  6316. @fillstack_loop:
  6317. mov bx,code
  6318. shl bx,1
  6319. push bx
  6320. mov ax,word ptr ab_tail[bx]
  6321. mov bx,stackp
  6322. shl bx,1
  6323. mov word ptr stack[bx],ax
  6324. inc stackp
  6325. pop bx
  6326. mov ax,word ptr ab_prfx[bx]
  6327. mov code,ax
  6328. cmp ax,clr
  6329. ja @fillstack_loop
  6330. @konkret:
  6331. mov bx,stackp
  6332. shl bx,1
  6333. mov word ptr stack[bx],ax
  6334. mov sonderfall,ax
  6335. inc stackp
  6336. mov bx,stackp
  6337. dec bx
  6338. shl bx,1
  6339. @readstack_loop:
  6340. mov ax,word ptr stack[bx]
  6341.  
  6342. stosb
  6343. or di,di
  6344. jne @noovl1
  6345. push startadr
  6346. push 16384
  6347. add startadr,16384
  6348. call p13_2_modex
  6349. les di,zielvarlok
  6350.  
  6351. @noovl1:
  6352. { add si,4
  6353. and si,12
  6354. or di,di
  6355. jne @rsnc
  6356. mov ax,es
  6357. add ax,1000h
  6358. mov es,ax
  6359. @rsnc:}
  6360. dec bx
  6361. dec bx
  6362. jns @readstack_loop
  6363. mov stackp,0
  6364. mov bx,free
  6365. shl bx,1
  6366. mov ax,old_code
  6367. mov word ptr ab_prfx[bx],ax
  6368. mov ax,code
  6369. mov word ptr ab_tail[bx],ax
  6370. mov ax,readbyt
  6371. mov old_code,ax
  6372. inc free
  6373. mov ax,free
  6374. cmp ax,max
  6375. jbe @mainloop
  6376. cmp byte ptr breite,12
  6377. jae @mainloop
  6378. inc breite
  6379. mov cl,byte ptr breite
  6380. mov ax,1
  6381. shl ax,cl
  6382. dec ax
  6383. mov max,ax
  6384. jmp @mainloop
  6385. @clear:
  6386. mov breite,9
  6387. mov max,511
  6388. mov free,258
  6389. call getlogbyte
  6390. mov sonderfall,ax
  6391. mov old_code,ax
  6392.  
  6393. stosb
  6394. or di,di
  6395. jne @noovl2
  6396. push startadr
  6397. push 16384
  6398. add startadr,16384
  6399. call p13_2_modex
  6400. les di,zielvarlok
  6401.  
  6402. @noovl2:
  6403. { add si,4
  6404. and si,12
  6405.  
  6406. or di,di
  6407. jne @mainloop
  6408. mov ax,es
  6409. add ax,1000h
  6410. mov es,ax }
  6411.  
  6412. jmp @mainloop
  6413. @abbruch:
  6414. End;
  6415. gifclose;
  6416. End;
  6417.  
  6418. procedure disable4; assembler;
  6419. asm;
  6420. mov dx,3c4h
  6421. mov ax,0f02h
  6422. out dx,ax
  6423.  
  6424. mov dx,3ceh
  6425. mov ax,4005h
  6426. out dx,ax
  6427. end;
  6428.  
  6429. Procedure ShowPic;assembler;
  6430. asm
  6431. push ds
  6432. mov di,0a000h
  6433. mov es,di
  6434. xor di,di
  6435. mov si,word ptr VScreen
  6436. mov ax,word ptr Vscreen + 2
  6437. mov ds,ax
  6438. mov cx,32000
  6439. rep movsw
  6440. pop ds
  6441. End;
  6442. Procedure ClearPic(Size:Word);assembler;
  6443. asm
  6444. mov ax,word ptr vscreen + 2
  6445. mov es,ax
  6446. mov di,word ptr vscreen
  6447. mov cx,Size
  6448. xor ax,ax
  6449. rep stosw
  6450. End;
  6451.  
  6452. Procedure WaitRetrace;assembler;
  6453. asm
  6454. mov dx,3dah
  6455. @wait1:
  6456. in al,dx
  6457. test al,8h
  6458. jz @wait1
  6459. @wait2:
  6460. in al,dx
  6461. test al,8h
  6462. jnz @wait2
  6463. End;
  6464.  
  6465. Procedure Init_Mode13;assembler;
  6466. asm
  6467. mov ax,13h
  6468. int 10h
  6469. End;
  6470.  
  6471. Procedure Init_ModeX;assembler;
  6472. asm
  6473. mov ax,0013h { Den normalen Mode 13h setzen }
  6474. int 10h
  6475.  
  6476. mov dx,3c4h { Verknpfung aufheben, Einzelzugriff }
  6477. mov al,4 { erm”glichen }
  6478. out dx,al
  6479. inc dx
  6480. in al,dx
  6481. and al,0f7h
  6482. or al,4h
  6483. out dx,al
  6484. dec dx
  6485. mov ax,0f02h
  6486. out dx,ax
  6487.  
  6488. mov ax,0a000h { Bildschirmspeicher l”schen }
  6489. mov es,ax
  6490. xor di,di
  6491. xor ax,ax
  6492. mov cx,8000h
  6493. cld
  6494. rep stosw
  6495.  
  6496. mov dx,3d4h
  6497. mov al,14h
  6498. out dx,al
  6499. inc dx
  6500. in al,dx
  6501. and al,0bfh
  6502. out dx,al
  6503. dec dx
  6504. mov al,17h
  6505. out dx,al
  6506. inc dx
  6507. in al,dx
  6508. or al,40h
  6509. out dx,al
  6510. End;
  6511.  
  6512. Procedure Start(Ofst:Word);assembler;
  6513. asm
  6514. mov dx,3d4h
  6515. mov al,0ch
  6516. mov ah,byte ptr ofst + 1
  6517. out dx,ax
  6518. inc al
  6519. mov ah,byte ptr ofst
  6520. out dx,ax
  6521. End;
  6522.  
  6523. Procedure Split(row:byte);assembler;
  6524. asm
  6525. mov bl,row
  6526. xor bh,bh
  6527. shl bx,1
  6528. mov cx,bx
  6529.  
  6530. mov dx,3d4h
  6531. mov al,07h
  6532. out dx,al
  6533. inc dx
  6534. in al,dx
  6535. and al,11101111b
  6536. shr cx,4
  6537. and cl,16
  6538. or al,cl
  6539. out dx,al
  6540.  
  6541. dec dx
  6542. mov al,09h
  6543. out dx,al
  6544. inc dx
  6545. in al,dx
  6546. and al,10111111b
  6547. shr bl,3
  6548. and bl,64
  6549. or al,bl
  6550. out dx,al
  6551.  
  6552. dec dx
  6553. mov al,18h
  6554. mov ah,row
  6555. shl ah,1
  6556. out dx,ax
  6557. End;
  6558.  
  6559. Procedure enable4;assembler;
  6560. asm
  6561. mov dx,3c4h
  6562. mov ax,0f02h
  6563. out dx,ax
  6564.  
  6565. mov dx,3ceh
  6566. mov ax,4105h
  6567. out dx,ax
  6568. End;
  6569.  
  6570.  
  6571. begin;
  6572. end.Unit Memory;
  6573. {
  6574. **************************************************************************
  6575. *** Die Memory - Unit des Buches PC Underground von DATA BECKER ***
  6576. *** Autor : Boris Bertelsons ***
  6577. *** Erstellt : 26.01.1994 ***
  6578. *** Letzte Žnderung : 18.03.1994 ***
  6579. *** ------------------------------------------------------------------ ***
  6580. *** Die Unit stellt Routinen fr den Umgang mit dem Speicher zur ***
  6581. *** Verfgung. Dies beinhaltet insbesondere Routinen zum Handling von ***
  6582. *** XMS und EMS ! ***
  6583. **************************************************************************
  6584. }
  6585.  
  6586. Interface
  6587.  
  6588. uses dos;
  6589.  
  6590. TYPE XMSHandle = word;
  6591.  
  6592. EMSHandle = word;
  6593.  
  6594. XMS_Copyblock = Record { Wird fr die Kopier-Routinen ben”tigt }
  6595. Size : longint;
  6596. Q_Handle : Word;
  6597. Q_Offset : pointer;
  6598. Z_Handle : Word;
  6599. Z_Offset : pointer;
  6600. end;
  6601.  
  6602. EMS_Header = Record { Zur Erkennung des EMS }
  6603. dummy : array[0..9] of byte;
  6604. Kennung : array[1..7] of char;
  6605. end;
  6606.  
  6607. VAR XMS_Vorhanden : boolean; { TRUE, wenn XMS vorhanden ist }
  6608. XMST : pointer; { Treiber - Einsprungadresse }
  6609. XMS_Version : word; { Die Version des XMS-Treibers }
  6610. XC : XMS_Copyblock;
  6611. EMS_Vorhanden : boolean; { TRUE, wenn EMS vorhanden }
  6612. EMS_Version : word; { Die Nummer der EMS-Version. Dabei steht
  6613. Vers.MAJ im Hi-Byte und VERS.MIN im
  6614. Lo-Byte ! }
  6615. EMS_Seiten_Frei : word; { Die Anzahl der Freien EMS-Seiten }
  6616. EMS_Seiten_Insg : word; { Die Anzahl der insgesamt verfgbaren
  6617. EMS-Seiten }
  6618.  
  6619.  
  6620. function base_free : longint;
  6621. {
  6622. Die Function liefert die Gr”áe des maximal insgesamt verfgbaren
  6623. Hauptspeichers in Bytes zurck
  6624. }
  6625.  
  6626. function XMS_free : longint;
  6627. {
  6628. Die Function liefert die Gr”áe des maximal insgesamt verfgbaren
  6629. XMS-Speichers in Bytes zurck
  6630. }
  6631.  
  6632. Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
  6633. {
  6634. Die Function allociert einen Size Bytes groáen Block im XMS. Dabei wird
  6635. Size auf die n„chste KB-Grenze aufgerundet. Die Nummer des Handels, unter
  6636. dem der Block angesprochen werden kann, wird in H zurckgeliefert, und
  6637. darf nicht verloren gehen, weil sonst der Block erst wieder durch ein
  6638. Reset angesprochen werden kann. Konnte der Speicher allociert werden, so
  6639. liefert die Function den Wert 0, sonst gilt die im Buch vorgestellte
  6640. Fehlertabelle.
  6641. }
  6642.  
  6643. Function Freemem_XMS(H : XMSHandle) : byte;
  6644. {
  6645. Die Function gibt einen ber GETMEM_XMS belegten Speicherbereich im XMS
  6646. wieder frei. Das Functions-Ergebnis gilt anhand der XMS-Fehlertabelle.
  6647. }
  6648.  
  6649. Function XMS_2_XMS(h1,h2 : XMSHandle; Size : Word) : byte;
  6650. {
  6651. Diese Function kopiert im XMS von h1 in h2 die in Size bergebene
  6652. Anzahl Bytes. Dabei muá Size einen GERADEN Wert haben. Fr das Functions-
  6653. Ergebnis gilt oben gesagtes.
  6654. }
  6655.  
  6656. Function RAM_2_XMS(q : pointer; h : XMSHandle; Size : Word) : byte;
  6657. {
  6658. Diese Function dient dazu, Daten aus dem Ram ins XMS zu kopieren.
  6659. q ist ein Pointer auf die Quell-Daten im RAM. h ist das Handle, das
  6660. Sie durch die Function GETMEM_XMS erhalten haben. Size ist die GrӇe
  6661. des zu kopierenden Blocks in Byte. Auch hier gilt oben gesagtes fr
  6662. die GrӇe des Blocks und das Functions-Ergebnis.
  6663. }
  6664.  
  6665. Function XMS_2_Ram(d : pointer; h : XMSHandle; Size : Word) : byte;
  6666. {
  6667. Diese Function dient dazu, Daten aus dem XMS ins Ram zu kopieren.
  6668. d ist ein Pointer auf den Ziel-Bereich im RAM. h ist das Handle, das
  6669. Sie durch die Function GETMEM_XMS erhalten haben. Size ist die GrӇe
  6670. des zu kopierenden Blocks in Byte. Auch hier gilt oben gesagtes fr
  6671. die GrӇe des Blocks und das Functions-Ergebnis.
  6672. }
  6673.  
  6674. Procedure Check_for_XMS;
  6675. {
  6676. Die Procedure prft, ob XMS vorhanden ist, und initialisiert die von der
  6677. Unit ben”tigten Variablen. XMS_Vorhanden wird auf TRUE gesetzt, wenn ein
  6678. XMS-Treiber vorhanden ist, die Versionsnummer des Treibers finden Sie in
  6679. XMS_Version.
  6680. }
  6681.  
  6682. procedure Check_for_EMS;
  6683. {
  6684. Die Procedure prft, ob EMS vorhanden ist, und initialisiert entsprechende
  6685. Variablen
  6686. }
  6687.  
  6688. Function EMS_free : longint;
  6689. {
  6690. Die Function liefert die gr”áe des freien EMS-Speichers in Bytes zurck.
  6691. }
  6692.  
  6693. Function EMS_Segment_ermitteln(VAR Segment : word) : byte;
  6694. {
  6695. Diese Function ermittelt das Segment, ab dem das EMS im Hauptspeicher
  6696. eingeblendet wird.
  6697. }
  6698.  
  6699. Function EMS_Ermittle_Seitenzahl : byte;
  6700. {
  6701. Diese Function ermittelt, wieviele Seiten im EMS insgesamt zur Verfgung
  6702. stehen, und wiviele davon noch frei sind. Die Werte werden in den globalen
  6703. Variablen "EMS_Seiten_Insg" und "EMS_Seiten_frei" abgelegt.
  6704. }
  6705.  
  6706. Function Getmem_EMS(VAR H : EMSHandle; Size : longint) : byte;
  6707. {
  6708. Diese Function allociert die angegebene Menge Speicher im EMS. Der
  6709. Speicher ist dann ber das Handle "H" ansprechbar. Bitte beachten Sie,
  6710. daá die Function wenigstens eine Seite, also 16KB im EMS, allociert.
  6711. Es sollten also m”glichst nur gr”áere Datenstrukturen im EMS ausgelagert
  6712. werden.
  6713. }
  6714.  
  6715. Function Freemem_EMS(H : EMSHandle) : byte;
  6716. {
  6717. Diese Function gibt den ber Getmem_EMS belegten Speicher wieder frei.
  6718. }
  6719.  
  6720. Function EMS_Zuordnung(H : EMSHandle;PageSeite,EMSSeite : word) : byte;
  6721. {
  6722. Mit dieser Funktion k”nnen Sie die Zuordnung der EMS-Seiten fr das
  6723. entsprechende Handle festlegen. Dabei kann PageSeite einen Wert von 0
  6724. bis 3 einnehmen, und steht fr die Seitenposition, an der sie im RAM
  6725. eingeblendet wird. EMSSeite ist die Seite im EMS, die eingeblendet
  6726. werden soll. Wenn Sie also dem Handle EMSH an erster Stelle die Seite 7
  6727. des EMS (interessant bei Bl”cken > 64 KB !) zuweisen wollen, máen Sie
  6728. die Function mit den Parametern (EMSH,0,7) aufrufen.
  6729. }
  6730.  
  6731. Function EMS_Sichere_Zuordnung(H : EMSHandle) : byte;
  6732. {
  6733. Diese Function sichert die ber EMS_Zuordnung eingestellte Ordnung der
  6734. EMS-Pages fr das angegebene Handle vor Ver„nderungen.
  6735. }
  6736.  
  6737. Function EMS_Entsichere_Zuordnung(H : EMSHandle) : byte;
  6738. {
  6739. Ein ber EMS_Sichere_Zuordnung gesichertes Handle muá zun„chst mit dieser
  6740. Function entsichert werden, bevor die Zuordnung ver„ndert werden kann.
  6741. }
  6742.  
  6743. Function RAM_2_EMS(q : pointer; H : EMSHandle; Size : longint) : byte;
  6744. {
  6745. Mit dieser Function kopieren Sie den angegebenen Block aus dem Ram ins
  6746. EMS. Size bezeichnet die Gr”áe in Bytes, q steht fr einen Pointer auf den
  6747. Quellbereich und H ist das ber Getmem_EMS ermittelte Handle.
  6748. }
  6749.  
  6750. Function EMS_2_RAM(q : pointer; H : EMSHandle; Size : longint) : byte;
  6751. {
  6752. Analog zu RAM_2_EMS kopiert diese Function einen Speicherbereich aus dem
  6753. Ram ins EMS.
  6754. }
  6755.  
  6756. Function EMS_Handles_vergeben(Var Anzahl : word) : byte;
  6757. {
  6758. Diese Function liefert Ihnen die Anzahl der bereits vergebenen EMS-Handles.
  6759. Es k”nnen maximal 256 Handles vergeben werden.
  6760. }
  6761.  
  6762. function XMS_lock(H : XMSHandle) : longint;
  6763. {
  6764. Die Funktion sperrt einen XMS-Block gegen das Verschieben und liefert
  6765. seine absolute Adresse
  6766. }
  6767.  
  6768. procedure XMS_unlock(H : XMSHandle);
  6769. {
  6770. Die Procedure entsichert einen gegen Verschieben gesicherten XMS-Block
  6771. }
  6772.  
  6773.  
  6774. implementation
  6775.  
  6776. function base_free : longint;
  6777. begin;
  6778. base_free := MemAvail;
  6779. end;
  6780.  
  6781. function XMS_free : longint;
  6782. var xms_in_kb : word;
  6783. xms_long: longint;
  6784. begin;
  6785. asm
  6786. mov ax,0800h { 8 = Freien Speicher Ermitteln }
  6787. call dword ptr [XMST]
  6788. mov xms_in_kb,dx
  6789. end;
  6790. xms_long := xms_in_kb;
  6791. XMS_free := xms_long * 1024;
  6792. end;
  6793.  
  6794. Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
  6795. var bsize : word;
  6796. Fresult : byte;
  6797. xmsh : word;
  6798. begin;
  6799. bsize := (size DIV 1024) + 1;
  6800. asm
  6801. mov ax,0900h { 9 = Speicherbereich allocieren }
  6802. mov dx,bsize
  6803. call dword ptr [XMST]
  6804. cmp ax,1
  6805. jne @Fehler_GetmemXms
  6806. mov xmsh,dx
  6807. mov Fresult,0
  6808. jmp @Ende_GetmemXms
  6809. @Fehler_GetmemXMS:
  6810. mov Fresult,bl
  6811. @Ende_GetmemXms:
  6812. end;
  6813. h := xmsh;
  6814. Getmem_Xms := Fresult;
  6815. end;
  6816.  
  6817. Function Freemem_XMS(H : XMSHandle) : byte;
  6818. var fresult : byte;
  6819. begin;
  6820. asm { A = Speicherbereich deallocieren }
  6821. mov ax,0a00h
  6822. mov dx,h
  6823. call dword ptr [XMST]
  6824. cmp ax,1
  6825. jne @Fehler_FreememXms
  6826. mov Fresult,0
  6827. jmp @Ende_FreememXms
  6828. @Fehler_FreememXms:
  6829. mov Fresult,bl
  6830. @Ende_FreememXms:
  6831. end;
  6832. end;
  6833.  
  6834. Function XMS_2_XMS(h1,h2 : XMSHandle; Size : Word) : byte;
  6835. VAR fresult : byte;
  6836. begin;
  6837. XC.Size := Size; { GrӇe des Blocks in Byte }
  6838. XC.Q_Handle := h1; { Quell-Handle }
  6839. XC.Q_Offset := nil; { Quell-Offset, 0 = Blockanfang }
  6840. XC.Z_Handle := h2; { Ziel-Handle }
  6841. XC.Z_Offset := nil; { Ziel-Offset }
  6842. asm
  6843. mov si,offset XC
  6844. mov ax,0B00h
  6845. call dword ptr [XMST]
  6846. cmp ax,1
  6847. jne @Fehler_RAM2XMS
  6848. mov fresult,0
  6849. jmp @Ende_Ram2XMS
  6850. @Fehler_Ram2XMS:
  6851. mov fresult,bl
  6852. @Ende_Ram2XMS:
  6853. end;
  6854. end;
  6855.  
  6856. Function RAM_2_XMS(q : pointer; h : XMSHandle; Size : Word) : byte;
  6857. VAR fresult : byte;
  6858. begin;
  6859. XC.Size := Size;
  6860. XC.Q_Handle := 0; { 0 = RAM }
  6861. XC.Q_Offset := q;
  6862. XC.Z_Handle := h;
  6863. XC.Z_Offset := nil;
  6864. asm
  6865. mov si,offset XC
  6866. mov ax,0B00h
  6867. call dword ptr [XMST]
  6868. cmp ax,1
  6869. jne @Fehler_RAM2XMS
  6870. mov fresult,0
  6871. jmp @Ende_Ram2XMS
  6872. @Fehler_Ram2XMS:
  6873. mov fresult,bl
  6874. @Ende_Ram2XMS:
  6875. end;
  6876. end;
  6877.  
  6878. Function XMS_2_Ram(d : pointer; h : XMSHandle; Size : Word) : byte;
  6879. VAR fresult : byte;
  6880. begin;
  6881. XC.Size := Size;
  6882. XC.Q_Handle := h;
  6883. XC.Q_Offset := nil;
  6884. XC.Z_Handle := 0; { 0 = RAM }
  6885. XC.Z_Offset := d;
  6886. asm
  6887. mov si,offset XC
  6888. mov ax,0B00h
  6889. call dword ptr [XMST]
  6890. cmp ax,1
  6891. jne @Fehler_XMS2RAM
  6892. mov fresult,0
  6893. jmp @Ende_XMS2Ram
  6894. @Fehler_XMS2Ram:
  6895. mov fresult,bl
  6896. @Ende_XMS2Ram:
  6897. end;
  6898. end;
  6899.  
  6900. Procedure Check_for_XMS; assembler;
  6901. asm
  6902. mov ax,4300h { Prfen, ob Treiber Installiert }
  6903. int 2Fh
  6904. cmp al,80h
  6905. jne @Kein_XMSTreiber
  6906. mov ax,4310h { Einsprungadresse des Treibers ermitteln }
  6907. int 2Fh
  6908. mov word ptr XMST + 2,es
  6909. mov word ptr XMST + 0,bx
  6910. xor ax,ax { Versionsnummer ermitteln }
  6911. call dword ptr [XMST]
  6912. cmp ax,0200h
  6913. jb @Kein_XMSTreiber { Wenn Version < 2.0 dann Abbrechen ! }
  6914. mov XMS_Version,ax
  6915. mov XMS_Vorhanden,0
  6916. @Kein_XMSTreiber:
  6917. mov XMS_Vorhanden,1
  6918. @Ende_XMS_Check:
  6919. end;
  6920.  
  6921. procedure Check_for_EMS;
  6922. var emsseg : word;
  6923. emsptr : pointer;
  6924. emshead : EMS_Header;
  6925. begin;
  6926. asm
  6927. mov ax,3567h
  6928. int 21h
  6929. mov emsseg,es
  6930. end;
  6931. move(ptr(emsseg,0)^,emshead,17);
  6932. if emshead.Kennung = 'EMMXXXX' then begin;
  6933. EMS_Vorhanden := true;
  6934. asm
  6935. mov ah,40h { EMS-Treiber Status ermitteln }
  6936. int 67h
  6937. cmp ah,0
  6938. jne @EMS_Vers_Fehler
  6939. mov ah,46h { EMS - Version ermitteln }
  6940. int 67h
  6941. cmp ah,0
  6942. jne @EMS_Vers_Fehler
  6943. mov bl,al
  6944. shr al,4
  6945. mov bh,al { bh = Vers.maj }
  6946. or bl,0Fh { bl = Vers.min }
  6947. mov EMS_Version,bx
  6948. jmp @EMS_Vers_Ende
  6949. @EMS_Vers_Fehler:
  6950. mov EMS_Vorhanden,1
  6951. @EMS_Vers_Ende:
  6952. end;
  6953. end else begin;
  6954. EMS_Vorhanden := false;
  6955. end;
  6956. end;
  6957.  
  6958. Function EMS_Segment_ermitteln(VAR Segment : word) : byte;
  6959. VAR hseg : word;
  6960. fergebnis : byte;
  6961. begin;
  6962. asm
  6963. mov ah,41h
  6964. int 67h
  6965. cmp ah,0
  6966. jne @EMS_Segerm_Fehler
  6967. mov hseg,bx
  6968. mov fergebnis,0
  6969. jmp @EMS_Segerm_Ende
  6970. @EMS_Segerm_Fehler:
  6971. mov fergebnis,ah
  6972. @EMS_Segerm_Ende:
  6973. end;
  6974. Segment := hseg;
  6975. EMS_Segment_ermitteln := fergebnis;
  6976. end;
  6977.  
  6978. Function EMS_Ermittle_Seitenzahl : byte;
  6979. var fergebnis : byte;
  6980. begin;
  6981. asm
  6982. mov ah,42h
  6983. int 67h
  6984. cmp ah,0
  6985. jne @EMS_ErmSeiten_Fehler
  6986. mov EMS_Seiten_Frei,bx
  6987. mov EMS_Seiten_Insg,dx
  6988. mov fergebnis,0
  6989. jmp @EMS_ErmSeiten_Ende
  6990. @EMS_ErmSeiten_Fehler:
  6991. mov fergebnis,ah
  6992. @EMS_ErmSeiten_Ende:
  6993. end;
  6994. EMS_Ermittle_Seitenzahl := fergebnis;
  6995. end;
  6996.  
  6997. function EMS_free : longint;
  6998. var hilfe : longint;
  6999. begin;
  7000. EMS_Ermittle_Seitenzahl;
  7001. hilfe := EMS_Seiten_Frei;
  7002. EMS_free := hilfe SHL 14;
  7003. end;
  7004.  
  7005. Function Getmem_EMS(VAR H : EMSHandle; Size : longint) : byte;
  7006. var Fergebnis : byte;
  7007. ESeiten : word;
  7008. Hhandle : word;
  7009. begin;
  7010. ESeiten := (Size DIV 16384) + 1;
  7011. asm
  7012. mov ah,43h
  7013. mov bx,ESeiten
  7014. int 67h
  7015. cmp ah,0
  7016. jne @Getmem_Ems_Fehler
  7017. mov Hhandle,dx
  7018. mov fergebnis,0
  7019. jmp @Getmem_Ems_Ende
  7020. @Getmem_Ems_Fehler:
  7021. mov Fergebnis,ah
  7022. @Getmem_Ems_Ende:
  7023. end;
  7024. H := Hhandle;
  7025. Getmem_EMS := Fergebnis;
  7026. end;
  7027.  
  7028. Function Freemem_EMS(H : EMSHandle) : byte;
  7029. var Fergebnis : byte;
  7030. begin;
  7031. asm
  7032. mov ah,45h
  7033. mov dx,H
  7034. int 67h
  7035. mov Fergebnis,ah
  7036. end;
  7037. Freemem_EMS := Fergebnis;
  7038. end;
  7039.  
  7040. Function EMS_Zuordnung(H : EMSHandle;PageSeite,EMSSeite : word) : byte;
  7041. VAR Fergebnis : byte;
  7042. begin;
  7043. asm
  7044. mov ah,44h
  7045. mov al,byte ptr PageSeite
  7046. mov bx,EMSSeite
  7047. mov dx,H
  7048. int 67h
  7049. mov Fergebnis,ah
  7050. end;
  7051. EMS_Zuordnung := Fergebnis;
  7052. end;
  7053.  
  7054. Function EMS_Sichere_Zuordnung(H : EMSHandle) : byte;
  7055. VAR Fergebnis : byte;
  7056. begin;
  7057. asm
  7058. mov ah,47h
  7059. mov dx,H
  7060. int 67h
  7061. mov Fergebnis,ah
  7062. end;
  7063. EMS_Sichere_Zuordnung := Fergebnis;
  7064. end;
  7065.  
  7066. Function EMS_Entsichere_Zuordnung(H : EMSHandle) : byte;
  7067. VAR Fergebnis : byte;
  7068. begin;
  7069. asm
  7070. mov ah,48h
  7071. mov dx,H
  7072. int 67h
  7073. mov Fergebnis,ah
  7074. end;
  7075. EMS_Entsichere_Zuordnung := Fergebnis;
  7076. end;
  7077.  
  7078. Function RAM_2_EMS(q : pointer; H : EMSHandle; Size : longint) : byte;
  7079. VAR fergebnis : byte;
  7080. EMSseg : word;
  7081. hp : ^byte;
  7082. li : word;
  7083. begin;
  7084. EMS_Segment_ermitteln(EMSseg);
  7085. hp := q;
  7086. if Size > 16384 then begin;
  7087. { Mehr al eine Page erforderlich }
  7088. for li := 0 to (Size SHR 14)-1 do begin;
  7089. EMS_Zuordnung(H,0,li);
  7090. move(hp^,ptr(EMSseg,0)^,16384);
  7091. dec(Size,16384);
  7092. inc(hp,16384);
  7093. end;
  7094. EMS_Zuordnung(H,0,li+1);
  7095. move(hp^,ptr(EMSseg,0)^,16384);
  7096. dec(Size,16384);
  7097. inc(hp,16384);
  7098. end else begin;
  7099. EMS_Zuordnung(H,0,0);
  7100. move(hp^,ptr(EMSseg,0)^,16384);
  7101. dec(Size,16384);
  7102. inc(hp,16384);
  7103. end;
  7104. end;
  7105.  
  7106. Function EMS_2_RAM(q : pointer; H : EMSHandle; Size : longint) : byte;
  7107. VAR fergebnis : byte;
  7108. EMSseg : word;
  7109. hp : ^byte;
  7110. li : word;
  7111. begin;
  7112. EMS_Segment_ermitteln(EMSseg);
  7113. hp := q;
  7114. if Size > 16384 then begin;
  7115. { Mehr al eine Page erforderlich }
  7116. for li := 0 to (Size SHR 14)-1 do begin;
  7117. EMS_Zuordnung(H,0,li);
  7118. move(ptr(EMSseg,0)^,hp^,16384);
  7119. dec(Size,16384);
  7120. inc(hp,16384);
  7121. end;
  7122. EMS_Zuordnung(H,0,li+1);
  7123. move(ptr(EMSseg,0)^,hp^,16384);
  7124. dec(Size,16384);
  7125. inc(hp,16384);
  7126. end else begin;
  7127. EMS_Zuordnung(H,0,0);
  7128. move(ptr(EMSseg,0)^,hp^,16384);
  7129. dec(Size,16384);
  7130. inc(hp,16384);
  7131. end;
  7132. end;
  7133.  
  7134. Function EMS_Seiten_belegt(H : EMSHandle;var Seiten : word) : byte;
  7135. var fergebnis : byte;
  7136. Hs : word;
  7137. begin;
  7138. asm
  7139. mov ah,4Ch
  7140. mov dx,H
  7141. int 67h
  7142. mov HS,bx
  7143. mov fergebnis,ah
  7144. end;
  7145. Seiten := Hs;
  7146. EMS_Seiten_belegt := Fergebnis;
  7147. end;
  7148.  
  7149. Function EMS_Handles_vergeben(Var Anzahl : word) : byte;
  7150. Var Fergebnis : byte;
  7151. Han : word;
  7152. begin;
  7153. asm
  7154. mov ah,4Bh
  7155. int 67h
  7156. mov Han,bx
  7157. mov Fergebnis,ah
  7158. end;
  7159. Anzahl := Han;
  7160. EMS_Handles_vergeben := Fergebnis;
  7161. end;
  7162.  
  7163. function XMS_lock(H : XMSHandle) : longint; assembler;
  7164. asm;
  7165. mov ax,0c00h
  7166. mov dx,h
  7167. call dword ptr [XMST]
  7168. mov ax,bx
  7169. end;
  7170.  
  7171. procedure XMS_unlock(H : XMSHandle); assembler;
  7172. asm;
  7173. mov ax,0d00h
  7174. mov dx,h
  7175. call dword ptr [XMST]
  7176. end;
  7177.  
  7178.  
  7179. begin;
  7180. Check_for_XMS;
  7181. Check_for_EMS;
  7182. end.
  7183.  
  7184.  
  7185.  
  7186.  
  7187.  
  7188.  
  7189.  
  7190.  
  7191.  
  7192.  
  7193. program Mem_test;
  7194.  
  7195. uses Memory,crt,gifunit;
  7196.  
  7197. var xmsh : array[1..2] of XMSHandle;
  7198. emsh : array[1..2] of EMSHandle;
  7199.  
  7200. procedure xms_testen;
  7201. var ta : array[1..20] of word;
  7202. li : integer;
  7203. begin;
  7204. { Array mit Zahlen versorgen & testweise ausgeben }
  7205. gotoxy(1,5); write('Orginal: ');
  7206. for li := 1 to 20 do begin;
  7207. ta[li] := li;
  7208. gotoxy(14,li+4);
  7209. write(ta[li]);
  7210. end;
  7211. readln;
  7212.  
  7213. { Array ins XMS sichern, mit 0 fllen und zur Kontrolle ausgeben }
  7214. gotoxy(21,5); write('Ins XMS gesichert &');
  7215. gotoxy(21,6); write('mit 0 gefllt:');
  7216. Getmem_XMS(xmsh[1],40);
  7217. RAM_2_XMS(@ta,xmsh[1],40);
  7218. fillchar(ta,40,0);
  7219. for li := 1 to 20 do begin;
  7220. gotoxy(44,li+4);
  7221. write(ta[li]);
  7222. end;
  7223. readln;
  7224.  
  7225. { Speicher im XMS kopieren, Array aus der Kopie im XMS wieder herstellen }
  7226. gotoxy(54,5); write('Aus XMS wieder');
  7227. gotoxy(54,6); write('hergestellt: ');
  7228. Getmem_XMS(xmsh[2],40);
  7229. XMS_2_XMS(xmsh[1],xmsh[2],40);
  7230. XMS_2_RAM(@ta,xmsh[2],40);
  7231. for li := 1 to 20 do begin;
  7232. gotoxy(74,li+4);
  7233. write(ta[li]);
  7234. end;
  7235. readln;
  7236. Freemem_XMS(xmsH[1]);
  7237. Freemem_XMS(xmsH[2]);
  7238. end;
  7239.  
  7240. procedure Ems_testen;
  7241. var ta : array[1..20] of word;
  7242. li : integer;
  7243. picptr : pointer;
  7244. begin;
  7245. getmem(picptr,64000);
  7246. Init_ModeX;
  7247. blackpal;
  7248. LoadGif('Beispiel.gif',picptr,0,0);
  7249. Getmem_EMS(emsh[1],64000);
  7250. RAM_2_EMS(picptr,emsh[1],64000);
  7251. freemem(picptr,64000);
  7252.  
  7253. getmem(vscreen,64000);
  7254. fillchar(vscreen^,64000,123);
  7255. EMS_2_RAM(vscreen,emsh[1],64000);
  7256. p13_2_modex(0,16000);
  7257. setpal;
  7258. readln;
  7259.  
  7260. freemem(vscreen,64000);
  7261. Freemem_EMS(emsH[1]);
  7262. asm mov ax,0003; int 10h; end;
  7263. end;
  7264.  
  7265. begin;
  7266. clrscr;
  7267. writeln('Programm zur Demonstration der Unit > MEMORY <');
  7268. writeln('(c) 1994 by DATA BECKER Autor: Boris Bertelsons');
  7269. writeln;
  7270. writeln('Freier Hauptspeicher: ',Base_Free,' Bytes');
  7271. writeln('Freies XMS : ',XMS_Free,' Bytes');
  7272. writeln('Freies EMS : ',EMS_Free,' Bytes');
  7273. writeln('XMS Version : ',hi(XMS_Version),'.',lo(XMS_Version));
  7274. writeln('EMS Version : ',hi(EMS_Version),'.',lo(EMS_Version));
  7275. readln;
  7276. clrscr;
  7277. writeln('Programm zur Demonstration der Unit > MEMORY <');
  7278. writeln('(c) 1994 by DATA BECKER Autor: Boris Bertelsons');
  7279. writeln;
  7280. writeln(' X M S - T E S T');
  7281. if XMS_Vorhanden then
  7282. xms_testen
  7283. else
  7284. writeln('Es ist kein XMS-Speicher vorhanden !');
  7285. clrscr;
  7286. writeln('Programm zur Demonstration der Unit > MEMORY <');
  7287. writeln('(c) 1994 by DATA BECKER Autor: Boris Bertelsons');
  7288. writeln;
  7289. writeln(' E M S - T E S T');
  7290. if EMS_Vorhanden then
  7291. ems_testen
  7292. else
  7293. writeln('Es ist kein EMS-Speicher vorhanden !');
  7294. end..386p
  7295. .MODEL TPASCAL
  7296. .DATA
  7297. oldint3 dd ?
  7298. alter_interrupt3 dd ?
  7299.  
  7300. .CODE
  7301.  
  7302. public PIQ_Stop_System
  7303. public Keyboard_aus
  7304. public Keyboard_ein
  7305. public No_Stepping
  7306.  
  7307.  
  7308. keyb_off macro
  7309. push ax
  7310. in al,21h
  7311. or al,02
  7312. out 21h,al
  7313. pop ax
  7314. endm
  7315.  
  7316. keyb_on macro
  7317. push ax
  7318. in al,21h
  7319. and al,0Fdh
  7320. out 21h,al
  7321. pop ax
  7322. endm
  7323.  
  7324. PIQ_Stop_System proc near
  7325. push ds
  7326. push ax
  7327. push bx
  7328. push cs
  7329. pop ds ; CS nach DS
  7330. mov cs:word ptr [@int_21_funkt],4CB4h ; Funktion Prg. beenden
  7331. @int_21_funkt:
  7332. mov ah,30h ; Funktion DOS-Vers. ermitteln
  7333. int 21h
  7334. pop bx
  7335. pop ax
  7336. pop ds
  7337. ret
  7338. PIQ_Stop_System endp
  7339.  
  7340. Keyboard_aus proc near
  7341. keyb_off
  7342. ret
  7343. Keyboard_aus endp
  7344.  
  7345. Keyboard_ein proc near
  7346. keyb_on
  7347. ret
  7348. Keyboard_ein endp
  7349.  
  7350. No_Stepping proc near
  7351. push ax
  7352. jmp @Nostep+2
  7353. @Nostep:
  7354. mov ds:byte ptr [06EBh],00
  7355. mov ax,4C01h
  7356. int 21h
  7357. pop ax
  7358. ret
  7359. No_Stepping endp
  7360.  
  7361. public protected_stopping
  7362. protected_stopping proc pascal
  7363. pusha
  7364. cli ; Interrupts ausschalten
  7365. mov eax,cr0 ; In den Protected-Mode schalten
  7366. or eax,1
  7367. mov cr0,eax
  7368. jmp PROTECTION_ENABLED ; Executionpipe l”schen
  7369. PROTECTION_ENABLED:
  7370.  
  7371. and al,0FEh ; Wieder in den Real-Mode schalten
  7372. mov cr0,eax ; CPU nicht resetten
  7373. jmp PROTECTION_DISABLED ; Executionpipe l”schen
  7374. PROTECTION_DISABLED:
  7375. sti ; Interrupts wieder einschalten
  7376. popa
  7377. ret
  7378. protected_stopping endp
  7379.  
  7380. public Check_auf_vector
  7381. Check_auf_vector proc pascal check : dword;
  7382. mov bx,0
  7383. mov es,bx
  7384. mov bx,18
  7385. mov eax,es:[bx]
  7386. mov oldint3,eax
  7387. mov eax,check
  7388. mov es:[bx],eax
  7389. ret
  7390. Check_auf_vector endp
  7391.  
  7392. public Vector_ok
  7393. Vector_ok proc pascal check : dword;
  7394. mov bx,0
  7395. mov es,bx
  7396. mov bx,18
  7397. mov eax,es:[bx]
  7398. cmp eax,check
  7399. je @check_ok
  7400. mov al,0
  7401. jmp @check_ende
  7402. @check_ok:
  7403. mov al,1
  7404. @check_ende:
  7405. ret
  7406. Vector_ok endp
  7407.  
  7408. public restore_Checkvector
  7409. restore_Checkvector proc pascal
  7410. mov bx,0
  7411. mov es,bx
  7412. mov bx,18
  7413. mov eax,oldint3
  7414. mov es:[bx],eax
  7415. ret
  7416. restore_Checkvector endp
  7417.  
  7418. public Copy_int21_int3
  7419. Copy_int21_int3 proc pascal
  7420. mov bx,0
  7421. mov es,bx
  7422. mov bx,18
  7423. mov eax,es:[bx]
  7424. mov alter_interrupt3,eax ; alten int3 sichern
  7425. mov bx,84 ; Int 21 laden
  7426. mov eax,es:[bx]
  7427. mov bx,18 ; in int3 speichern
  7428. mov es:[bx],eax
  7429. ret
  7430. Copy_int21_int3 endp
  7431.  
  7432.  
  7433.  
  7434. end{$M $4000,550000,550000}
  7435. program nodebug;
  7436.  
  7437. uses crt;
  7438.  
  7439. {$L nodeb.obj}
  7440. procedure PIQ_Stop_System; far; external;
  7441. procedure keyboard_aus; far; external;
  7442. procedure keyboard_ein; far; external;
  7443. procedure no_stepping; far; external;
  7444. procedure protected_stopping; far; external;
  7445. procedure check_auf_Vector(check : longint); far; external;
  7446. procedure Restore_checkVector; far; external;
  7447. function Vector_OK(check : longint) : boolean; far; external;
  7448. procedure Copy_int21_int3; far; external;
  7449.  
  7450. begin;
  7451. clrscr;
  7452. writeln('Checksumme auf Int3-Vector');
  7453. check_auf_Vector(12345678);
  7454. writeln('Keyboard ausschalten');
  7455. keyboard_aus;
  7456. writeln('Stepping-Falle');
  7457. no_stepping;
  7458. writeln('PIQ-Trick');
  7459. PIQ_Stop_System;
  7460. writeln('Protected-Mode switching');
  7461. Protected_stopping;
  7462. writeln('Vector-Checking');
  7463. If NOT Vector_Ok(12345678) then begin;
  7464. clrscr;
  7465. writeln('Na na, nicht debuggen !');
  7466. halt(0);
  7467. end;
  7468. writeln('Check-Vector wieder herstellen');
  7469. Restore_checkVector;
  7470. writeln('Keyboard wieder einschalten');
  7471. keyboard_ein;
  7472. writeln('Und wir sind im Programm');
  7473. readln;
  7474. end.
  7475. {$M $4000,550000,550000}
  7476. program nodebug;
  7477.  
  7478. uses crt;
  7479.  
  7480. {$L nodeb.obj}
  7481.  
  7482. procedure PIQ_Stop_System; far; external;
  7483. procedure keyboard_aus; far; external;
  7484. procedure keyboard_ein; far; external;
  7485. procedure no_stepping; far; external;
  7486. procedure protected_stopping; far; external;
  7487. procedure check_auf_Vector(check : longint); far; external;
  7488. procedure Restore_checkVector; far; external;
  7489. function Vector_OK(check : longint) : boolean; far; external;
  7490. procedure Copy_int21_int3; far; external;
  7491.  
  7492.  
  7493. begin;
  7494. clrscr;
  7495.  
  7496. writeln('Checksumme auf Int3-Vector');
  7497. check_auf_Vector(12345678);
  7498.  
  7499. writeln('Keyboard ausschalten');
  7500. keyboard_aus;
  7501.  
  7502. writeln('Stepping-Falle');
  7503. no_stepping;
  7504.  
  7505. writeln('PIQ-Trick');
  7506. PIQ_Stop_System;
  7507.  
  7508. writeln('Protected-Mode switching');
  7509. Protected_stopping;
  7510.  
  7511. writeln('Vector-Checking');
  7512. If NOT Vector_Ok(12345678) then begin;
  7513. clrscr;
  7514. writeln('Na na, nicht debuggen !');
  7515. halt(0);
  7516. end;
  7517.  
  7518. writeln('Check-Vector wieder herstellen');
  7519. Restore_checkVector;
  7520.  
  7521. writeln('Keyboard wieder einschalten');
  7522. keyboard_ein;
  7523.  
  7524. writeln('Und wir sind im Programm');
  7525. readln;
  7526. end.
  7527.  
  7528.  
  7529.  
  7530.  
  7531.  
  7532. data segment public
  7533. start_meldung: db 'Kein Reset mehr m”glich',0dh,0ah,'$'
  7534. puffer: db 40d ;L„nge des Eingabe-Puffers
  7535. db 40 dup (0) ;Puffer
  7536. old_int9 dd 0 ;alter Interrupt-Hanlder
  7537. data ends
  7538.  
  7539. code segment public
  7540. assume cs:code,ds:data
  7541. handler9 proc near ;neuer Interrupt 9-Handler
  7542. push ax ;benutzte Register sichern
  7543. push bx
  7544. push ds
  7545. push es
  7546. mov ax,data ;ds laden
  7547. mov ds,ax
  7548.  
  7549. in al,60h ;Zeichen von Tastatur lesen in al
  7550.  
  7551. xor bx,bx ;es auf Segment 0
  7552. mov es,bx
  7553. mov bl,byte ptr es:[417h] ;Tastatur-Status in bl laden
  7554.  
  7555. cmp al,83d ;Scan-Code der Entf-Taste ?
  7556. jne kein_Reset ;nein, dann kein Reset
  7557.  
  7558. and bl,0ch ;Strg u. Alt maskieren
  7559. cmp bl,0ch ;beide gedrckt ?
  7560. jne kein_Reset ;nein, dann kein Reset
  7561.  
  7562. Block: ;Reset oder Break, also blockieren
  7563. mov al,20h ;EoI an Interrupt-Controller senden
  7564. out 20h,al
  7565. jmp fertig ;und Interrupt verlassen
  7566.  
  7567. kein_Reset: ;kein Reset, jetzt noch Brak prfen
  7568. cmp al,224d ;erweiterte Taste ?
  7569. je evtl_Break ;ja -> eventuell Break ausgel”st
  7570. cmp al,46d ;Taste 'C' ?
  7571. jne legal ;nein -> legale Taste
  7572. evtl_Break:
  7573. test bl,4 ;Tastatur-Status auf Strg testen
  7574. jne Block ;gedrckt, dann blockieren
  7575.  
  7576.  
  7577. legal: ;legale Taste -> alten Handler aufrufen
  7578. pushf
  7579. call dword ptr [old_int9] ;Original-Handler aufrufen
  7580. fertig:
  7581. pop es
  7582. pop ds ;Register zurckholen
  7583. pop bx
  7584. pop ax
  7585. iret
  7586. handler9 endp
  7587.  
  7588. start proc near
  7589. mov ax,data ;ds laden
  7590. mov ds,ax
  7591. mov dx,offset start_meldung ;dx mit Offset d. Meldung laden
  7592. mov ah,09h ;Meldung ausgeben
  7593. int 21h
  7594.  
  7595. mov ax,3509h ;alten Interrupt-Vektor lesen
  7596. int 21h
  7597. mov word ptr old_int9,bx ;und speichern
  7598. mov word ptr old_int9 + 2, es
  7599.  
  7600. push ds ;ds sichern
  7601. mov ax,cs ;mit cs laden
  7602. mov ds,ax
  7603. mov dx,offset handler9 ;auch Offset des Handlers laden
  7604. mov ax,2509h ;Vektor setzen
  7605. int 21h
  7606. pop ds
  7607.  
  7608. ;-------------------------------------------------------------------------
  7609. ;Hier kann statt des Dos-Aufrufs ein Call zu Ihrem Hauptprogramm stehen
  7610.  
  7611. mov ah,0ah ;Zeichenkette einlesen
  7612. lea dx,puffer ;als Beispiel-Hauptprogramm
  7613. int 21h
  7614. ;-------------------------------------------------------------------------
  7615.  
  7616. push ds
  7617. lds dx,old_int9 ;alten Vektor wieder setzen
  7618. mov ax,2509h
  7619. int 21h
  7620. pop ds
  7621.  
  7622. mov ax,4c00h ;Programm beenden
  7623. int 21h
  7624. start endp
  7625.  
  7626. code ends
  7627. end start
  7628.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!