home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / baspcx / llpcx.bas < prev    next >
Encoding:
BASIC Source File  |  1991-12-17  |  6.5 KB  |  173 lines
  1. '* -------------------------------------------------- *
  2. '*                     LLPCX.BAS                      *
  3. '*         (C) 1991 A. Maslo & DMV-Verlag             *
  4. '*               Sprache: Quick Basic                 *
  5. '*       Funktion: PCX-Lader für VGA, 640x480         *
  6. '* -------------------------------------------------- *
  7.  
  8. '* Deklarationsteil
  9.  
  10. DECLARE FUNCTION Combine% (FirstByte$, SecondByte$)
  11. DECLARE SUB LoadPCX (Datei$)
  12. DECLARE SUB ClosePCX ()
  13. DECLARE SUB OpenPCX (Datei$)
  14. DECLARE FUNCTION PCXHeader$ ()
  15. DECLARE SUB PCXInit ()
  16.  
  17. '* Hauptprogramm
  18.  
  19. CLS
  20. ON ERROR GOTO ErrorHandling         '* Fehlerbehandlung
  21. Datei$ = COMMAND$     '* Parameter entspricht Dateiname
  22. IF Datei$ = "" THEN
  23.                                 '* Parameter vorhanden?
  24.   ERROR 1                       '* falls nicht, Fehler!
  25. END IF
  26. IF RIGHT$(Datei$, 4) <> ".PCX" THEN
  27.                               '* Suffix angegeben?
  28.   Datei$ = Datei$ + ".PCX"    '* falls nicht, ergänzen!
  29. END IF
  30. LoadPCX Datei$              '* Datei laden und anzeigen
  31. WHILE INKEY$ = "": WEND     '* auf Taste warten
  32. END                         '* Programm beenden
  33.  
  34. ErrorHandling:
  35.   PRINT "Datei kann nicht ausgegeben werden..."
  36.   PRINT "Programmaufruf: PCX Datei <─┘"
  37.   END
  38. RESUME
  39.  
  40. SUB ClosePCX                     '* Datei schließen
  41.   SHARED PCXNr                   '* globale Dateinummer
  42.   CLOSE #PCXNr
  43. END SUB
  44.  
  45. FUNCTION Combine% (FirstByte$, SecondByte$) 
  46. '* Speicherwort aus zwei Bytes generieren
  47.   First% = ASC(FirstByte$)                      
  48.   Second% = ASC(SecondByte$)
  49.   Combine% = INT(First% + Second% * 256)
  50. END FUNCTION
  51.  
  52. SUB LoadPCX (Datei$)    '* PCX-Datei laden und anzeigen
  53.   SHARED PCXNr                                  
  54.   '* globale Variablen im Modul
  55.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  56.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  57.   SCREEN 12                                     
  58.   '* 640x480 Pixel
  59.   OpenPCX Datei$                                
  60.   '* Datei öffnen
  61.   PCXInit                                       
  62.   '* Kopfinformationen lesen
  63.   OUT &H3CE, 5
  64.   OUT &H3CF, 0
  65.   OUT &H3CE, 1
  66.   OUT &H3CF, 0
  67.   DEF SEG = &HA000                              
  68.   '* Segment der Grafikkarte
  69.   Byte$ = SPACE$(1)                             
  70.   '* Informationseinheit
  71.   Zeile$ = SPACE$(BpL%)                         
  72.   '* Länge einer Bildschirmzeile
  73.   FOR K% = 0 TO y2% - y1%                       
  74.   '* Einzelne Bildschirmzeile
  75.     FOR J% = 0 TO Ebenen% - 1                   
  76.   '* Ebenen innerhalb Bildschirmzeile
  77.       Zeile$ = RIGHT$(Zeile$, LEN(Zeile$) - BpL%)
  78.       I% = 0                                    
  79.       '* Informationen
  80.       WHILE NOT I% >= BpL%                      
  81.       '* Information für Zeile ausreichend
  82.         GET #PCXNr, , Byte$      '* Byte lesen (String)
  83.         Byte% = ASC(Byte$)       '* Byte in ASCII-Wert 
  84.                                  '* konvertieren
  85.         IF Byte% \ (2 ^ 6) = 3 THEN             
  86.         '* obere 2 Bits gesetzt?
  87.             Zaehler% = Byte% XOR &HC0           
  88.             '* 6 untere Bits ergeben Zaehler%
  89.             GET #PCXNr, , Byte$      '* Bildinformation
  90.             FOR a% = 1 TO Zaehler%   '* dekomprimieren
  91.               Zeile$ = Zeile$ + Byte$           
  92.               '* ersetzt Byte$ f.BildInfo$
  93.             NEXT a%
  94.           ELSE                                  
  95.           '* keine Dekomprimierung notwendig
  96.             Zaehler% = 1       '* einmalige Information
  97.             Zeile$ = Zeile$ + Byte$        '* BildInfo$
  98.         END IF
  99.         I% = LEN(Zeile$) '* Gesamtlänge der Information
  100.       WEND
  101.       OUT &H3C4, 2
  102.       OUT &H3C5, 1 * (2 ^ J%)                   
  103.       '* Ebene umschalten
  104.       Adr = K% * 80     '* Startadresse linker Rand und
  105.       P% = 0            '* Zeilenposition ergibt Offset
  106.       FOR Z% = 1 TO BpL% - 1                    
  107.          '* Bytes der Zeile direkt in
  108.          POKE Adr + P%, ASC(MID$(Zeile$, Z%, 1))
  109.          '* Bildschirmspeicher schreiben
  110.          P% = P% + 1
  111.       NEXT Z%
  112.     NEXT J%
  113.   NEXT K%
  114.   ClosePCX '* Datei schließen
  115.   DEF SEG  '* Umschaltung BASIC-Segment
  116. END SUB
  117.  
  118. SUB OpenPCX (Datei$)     '* PCX-Datei öffnen
  119.   SHARED PCXNr           '* globale Dateinummer
  120.   PCXNr = FREEFILE       '* freie Dateinummer verwenden
  121.   OPEN Datei$ FOR BINARY AS #PCXNr
  122.   '* Datei binär öffnen
  123. END SUB
  124.  
  125. FUNCTION PCXHeader$           '* PCX-Header lesen
  126.   SHARED PCXNr                '* globale Dateinummer
  127.   Header$ = SPACE$(128)       '* Dateikopf mit 128 Byte
  128.   IF LOF(PCXNr) >= 128 THEN                     
  129. '* Dateilänge ausreichend ?
  130.     GET #PCXNr, , Header$     '* Kopf lesen
  131.     PCXHeader$ = Header$      '* Zuweisung
  132.   END IF
  133. END FUNCTION
  134.  
  135. SUB PCXInit                   '* Dateikopf auswerten
  136.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  137.                               '* im Modul global
  138.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  139.   Header$ = PCXHeader$        '* binäre Informationen
  140.   ID% = ASC(LEFT$(Header$, 1))     '*   ID=10, 1 Byte
  141.   Ver% = ASC(MID$(Header$, 2, 1))  '*   Version, 1 Byte
  142.   Komp% = ASC(MID$(Header$, 3, 1))              
  143.                          '* Komprimierungsart=1, 1 Byte
  144.   Bits% = ASC(MID$(Header$, 4, 1))
  145.                          '* Bits pro Bildpunkt, 1 Byte
  146.   x1% = Combine%(MID$(Header$, 5, 1), _
  147.    MID$(Header$, 6, 1))  '* linke obere Ecke, 2 Bytes
  148.   y1% = Combine%(MID$(Header$, 7, 1), _
  149.    MID$(Header$, 8, 1))  '* linke obere Ecke, 2 Bytes
  150.   x2% = Combine%(MID$(Header$, 9, 1), _
  151.    MID$(Header$, 10, 1)) '* rechte untere Ecke, 2 Bytes
  152.   y2% = Combine%(MID$(Header$, 11, 1), _
  153.    MID$(Header$, 12, 1))     
  154.                          '* rechte untere Ecke, 2 Bytes
  155.   AX% = Combine%(MID$(Header$, 13, 1), _
  156.    MID$(Header$, 14, 1))      '* hor. Auflösung 2 Bytes
  157.   ay% = Combine%(MID$(Header$, 15, 1), _
  158.    MID$(Header$, 16, 1))      '* ver. Auflösung 2 Bytes
  159.   Pal$ = MID$(Header$, 17, 48)                                
  160.   '* Palette jeweils 3 Byte
  161.   Reserve% = ASC(MID$(Header$, 65, 1))       '* Reserve
  162.   Ebenen% = ASC(MID$(Header$, 66, 1))         
  163.                                '* Anzahl der Farbebenen
  164.   BpL% = Combine%(MID$(Header$, 67, 1), _
  165.    MID$(Header$, 68, 1))  '* Anzahl Bytes/Zeile, 2 Byte
  166.   Pal% = Combine%(MID$(Header$, 69, 1), _
  167.    MID$(Header$, 70, 1))             '* Art der Palette
  168.   Rest$ = RIGHT$(Header$, 58)        '* unbenutzt
  169. END SUB
  170.  
  171. '* -------------------------------------------------- *
  172. '*              Ende von LLPCX.BAS                    *
  173.