home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / UNITS / X_PAL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-13  |  25KB  |  701 lines
  1. unit X_Pal;
  2. (*----------------------------------------------------------------------- *)
  3. (* MODULE X_PAL                                                           *)
  4. (*                                                                        *)
  5. (* Palette functions all MODE X 256 Color resolutions                     *)
  6. (*                                                                        *)
  7. (*                                                                        *)
  8. (* ****** XLIB - Mode X graphics library                ****************  *)
  9. (* ******                                               ****************  *)
  10. (* ****** Written By Themie Gouthas                     ****************  *)
  11. (* ****** Converted by Christian Harms                  ****************  *)
  12. (*                                                                        *)
  13. (* egg@dstos3.dsto.gov.au  or  teg@bart.dsto.gov.au                       *)
  14. (* harms@minnie.informatik.uni-stuttgart.de                               *)
  15. (*----------------------------------------------------------------------- *)
  16.  
  17. (*
  18.  
  19.  
  20.     All the functions in this module operate on two variations of the
  21.     pallete buffer, the raw and annotated buffers.
  22.  
  23.     All those functions ending in buff operate on the following palette
  24.     structure:
  25.  
  26.        BYTE:r0,g0,b0,r1,g1,b1,...rn,gn,bn
  27.  
  28.     No reference to the starting colour index or number of colours stored
  29.     is contained in the structure.
  30.  
  31.     All those functions ending in struc operate on the following palette
  32.     structure:
  33.  
  34.        BYTE:c,BYTE:n,BYTE:r0,g0,b0,r1,g1,b1,...rn,gn,bn
  35.  
  36.     where c is the starting colour and n is the number of colours stored
  37.  
  38.  
  39.     NOTE: previously interrupts were disabled for DAC reads/writes but
  40.       they have been left enabled in this version to allow the mouse
  41.       interrupt to be invoked.
  42.  
  43.     All functions with raw-palettes can uses with the type Palette from
  44.     X_Const (for example : Dark2Pal,Pal2Dark,x_put_pal_raw ).
  45.  
  46. *)
  47.  
  48. interface
  49.  
  50. (*----------------------------------------------------------------------   *)
  51. (* Read DAC palette into annotated type buffer with interrupts disabled    *)
  52. (* ie BYTE colours to skip, BYTE colours to set, r1,g1,b1,r1,g2,b2...rn,gn,bn *)
  53. (*                                                                         *)
  54. (* WARNING: memory for the palette buffers must all be pre-allocated       *)
  55. (*                                                                         *)
  56. (* Written by Themie Gouthas                                               *)
  57. (*----------------------------------------------------------------------   *)
  58. procedure x_get_pal_struc(Var PalBuff;NumColors,StartColor:Word);
  59.  
  60. (*----------------------------------------------------------------------   *)
  61. (* Read DAC palette into raw buffer with interrupts disabled               *)
  62. (* ie BYTE r1,g1,b1,r1,g2,b2...rn,gn,bn                                    *)
  63. (*                                                                         *)
  64. (* WARNING: memory for the palette buffers must all be pre-allocated       *)
  65. (*                                                                         *)
  66. (* Written by Themie Gouthas                                               *)
  67. (*----------------------------------------------------------------------   *)
  68. procedure x_get_pal_raw(Var PalBuff;NumColors,StartColor:Word);
  69.  
  70. (*----------------------------------------------------------------------   *)
  71. (* Write DAC palette from annotated type buffer with interrupts disabled   *)
  72. (* ie BYTE colours to skip, BYTE colours to set, r1,g1,b1,r1,g2,b2...rn,gn,bn *)
  73. (* If DoWait true, VSyncWait will start.                                   *)
  74. (*                                                                         *)
  75. (* Written by Themie Gouthas                                               *)
  76. (*----------------------------------------------------------------------   *)
  77. procedure x_put_pal_struc(Var CompPalBuff;DoWait:Boolean);
  78.  
  79. (*----------------------------------------------------------------------   *)
  80. (* Write DAC palette from annotated type buffer with interrupts disabled   *)
  81. (* starting at a new palette index                                         *)
  82. (*                                                                         *)
  83. (* ie BYTE colours to skip, BYTE colours to set, r1,g1,b1,r1,g2,b2...rn,gn,bn *)
  84. (* If DoWait true, VSyncWait will start.                                   *)
  85. (*                                                                         *)
  86. (* WARNING: memory for the palette buffers must all be pre-allocated       *)
  87. (*                                                                         *)
  88. (* Written by Themie Gouthas                                               *)
  89. (*----------------------------------------------------------------------   *)
  90. procedure x_transpose_pal_struc(Var CompPalBuff;StartColor:Word;DoWait:Boolean);
  91.  
  92. (*----------------------------------------------------------------------   *)
  93. (* Write DAC palette from raw buffer with interrupts disabled              *)
  94. (* ie BYTE r1,g1,b1,r1,g2,b2...rn,gn,bn                                    *)
  95. (* If DoWait true, VSyncWait will start.                                   *)
  96. (*                                                                         *)
  97. (* Written by Themie Gouthas                                               *)
  98. (*----------------------------------------------------------------------   *)
  99. procedure x_put_pal_raw(Var PalBuff;NumColors,StartColor:Word;DoWait:Boolean);
  100.  
  101. (*----------------------------------------------------------------------   *)
  102. (* Set the RGB setting of a vga color                                      *)
  103. (*                                                                         *)
  104. (*                                                                         *)
  105. (* Written by Themie Gouthas                                               *)
  106. (*----------------------------------------------------------------------   *)
  107. procedure x_set_rgb(ColorIndex,R,G,B:Byte);
  108.  
  109. (*----------------------------------------------------------------------   *)
  110. (* Rotate annotated palette buffer entries                                 *)
  111. (*                                                                         *)
  112. (* Direction : 0 = backward 1 = forward                                    *)
  113. (*                                                                         *)
  114. (* Written by Themie Gouthas                                               *)
  115. (*----------------------------------------------------------------------   *)
  116. procedure x_rot_pal_struc(Var PalBuff;Direction:Word);
  117.  
  118. (*----------------------------------------------------------------------   *)
  119. (* Rotate raw palette buffer                                               *)
  120. (*                                                                         *)
  121. (* Direcction : 0 = backward 1 = forward                                   *)
  122. (*                                                                         *)
  123. (* Written by Themie Gouthas                                               *)
  124. (*----------------------------------------------------------------------   *)
  125.  
  126. procedure x_rot_pal_raw(Var PalBuff;Direction,NumColors:Word);
  127. (*----------------------------------------------------------------------   *)
  128. (* Copy palette making intensity adjustment                                *)
  129. (* x_cpcontrast_pal_struc(char far *src_pal, char far *dest_pal, unsigned char Intensity) *)
  130. (*                                                                         *)
  131. (* WARNING: memory for the palette buffers must all be pre-allocated       *)
  132. (*                                                                         *)
  133. (* Written by Themie Gouthas                                               *)
  134. (*----------------------------------------------------------------------   *)
  135. procedure x_cpcontrast_pal_struc(Var PalSrcBuff,PalDestBuff;Intensity:Byte);
  136.  
  137. (*----------------------------------------------------------------------   *)
  138. (* Write DAC palette from annotated type buffer with specified intensity   *)
  139. (* ie BYTE colours to skip, BYTE colours to set, r1,g1,b1,r1,g2,b2...rn,gn,bn *)
  140. (*                                                                         *)
  141. (* x_put_contrast_pal_struc(char far * pal, unsigned char  intensity)      *)
  142. (*                                                                         *)
  143. (* Designed for fading in or out a palette without using an intermediate   *)
  144. (* working palette buffer ! (Slow but memory efficient ... OK for small    *)
  145. (* pal strucs}                                                             *)
  146. (*                                                                         *)
  147. (* Written by Themie Gouthas                                               *)
  148. (*----------------------------------------------------------------------   *)
  149.  
  150. procedure x_put_contrast_pal_struc(Var CompPalBuff;Intensity:Byte);
  151.  
  152. (* This procedure set a RGB (6-7-6 Level), which are used also from some   *)
  153. (* professional Programms like Photo Styler or default pal of BEX  ;-)     *)
  154. procedure x_Set_RGB_pal;
  155.  
  156. (* Simply set_pal to set all colors are (0,0,0) . *)
  157. procedure x_set_Black_pal;
  158.  
  159. (* Soften Set_Pal in Black Screen. *)
  160. procedure x_Dark2Pal(var Colors);
  161.  
  162. (* Soften Set_Pal from Black Screen. *)
  163. procedure x_Pal2Dark(var Colors);
  164.  
  165.  
  166. implementation
  167.  
  168. uses X_Const,My_Asm;
  169.  
  170. var Work_Pal:^Palette;
  171.  
  172. procedure x_get_pal_struc(Var PalBuff;NumColors,StartColor:Word); assembler;
  173. asm
  174.      push  di
  175.      push  si
  176.      cld
  177.  
  178.      les   di,dword ptr [PalBuff]  (* Point es:di to palette buffer        *)
  179.      mov   si,[StartColor]         (* Store the Start Colour               *)
  180.      mov   ax,si
  181.      stosb
  182.      mov   dx,[NumColors]          (* Store the Number of Colours          *)
  183.      mov   al,dl
  184.      stosb
  185.  
  186.      mov   cx,dx                   (* setup regs and jump                  *)
  187.  
  188.      cld
  189.      (* call WaitVsyncStart *)
  190.      mov  ax,si
  191.      mov  dx,DAC_READ_INDEX
  192.      cli
  193.      out  dx,al                    (* Tell DAC what colour to start reading*)
  194.      mov  dx,DAC_DATA
  195.  
  196.      mov  bx,cx                    (* set cx to Num Colors * 3 ( size of   *)
  197.      shl  bx,1                     (* palette buffer)                      *)
  198.      add  cx,bx
  199.  
  200.      dw   _rep_insb                (* read the palette enntries            *)
  201.  
  202.      sti
  203.      pop  si
  204.      pop  di
  205. end;
  206.  
  207.  
  208. procedure x_get_pal_raw(Var PalBuff;NumColors,StartColor:Word); assembler;
  209. asm
  210.      push  di
  211.      push  si
  212.  
  213.      les   di,dword ptr [PalBuff]  (* Point es:di to palette buffer        *)
  214.  
  215.      mov  si,[StartColor]
  216.      mov  cx,[NumColors]
  217.  
  218.      cld
  219.      (* call WaitVsyncStart *)
  220.      mov  ax,si
  221.      mov  dx,DAC_READ_INDEX
  222.      cli
  223.      out  dx,al                    (* Tell DAC what colour to start reading*)
  224.      mov  dx,DAC_DATA
  225.  
  226.      mov  bx,cx                    (* set cx to Num Colors * 3 ( size of   *)
  227.      shl  bx,1                     (* palette buffer)                      *)
  228.      add  cx,bx
  229.  
  230.      dw   _rep_insb                (* read the palette enntries            *)
  231.  
  232.      sti
  233.      pop  si
  234.      pop  di
  235. end;
  236.  
  237. (* Intern asm-procedure *)
  238. procedure WritePalEntry; assembler;
  239. asm
  240.         mov  di,Dx
  241.  
  242.         or   cx,cx
  243.     jz   @@Done
  244. {    cli}
  245.     cld                      (* Make sure we're going the right way    *)
  246.         mov  ax,bx
  247.     mov  bx,60               (* set the vsync check timer (Vsync       *)
  248.                             (* is tested for at each bx'th entry to   *)
  249.                  (* prevent snow 60 is otimum for 10       *)
  250.                  (* MHz 286 or greater                     *)
  251.  
  252. @@SetLoop:
  253.     mov  dx,DAC_WRITE_INDEX  (* Tell DAC what colour index to start    *)
  254.     out  dx,al               (* writing from                           *)
  255.     mov  dx,DAC_DATA
  256.  
  257.     db   _outsb              (* Set the red component                  *)
  258.     db   _outsb              (* Set the green component                *)
  259.     db   _outsb              (* Set the blue component                 *)
  260.     inc  al                  (* increment the colour index             *)
  261.     dec  bx                  (* decrement vsync test counter           *)
  262.     js   @@test_vsync        (* ready to test for vsync again ?        *)
  263.     loop @@SetLoop           (* No! - continue loop                    *)
  264.     jmp  @@Done              (* All colours done                       *)
  265.  
  266. @@test_vsync:
  267.         cmp     di,false         (* DoWait=false ?  *)
  268.         je      @NoWait
  269.     mov     dx,INPUT_STATUS_0
  270.     push    ax               (* save current colour index              *)
  271. @@Wait:
  272.     in      al,dx            (* wait for vsync leading edge pulse      *)
  273.     test    al,08h
  274.         jz      @@Wait           (* If DoWait=false then  nop;nop          *)
  275.  
  276.         pop     ax               (* restore current colour index           *)
  277. @NoWait:mov     bx,60            (* reset vsync test counter               *)
  278.     loop @@SetLoop           (* loop for next colour index             *)
  279.  
  280. @@Done:
  281. {    sti}
  282. end;
  283.  
  284.  
  285.  
  286. procedure x_put_pal_struc(Var CompPalBuff;DoWait:Boolean); assembler;
  287. asm
  288.     push    ds
  289.     push    si
  290.     cld
  291.     lds     si,[CompPalBuff]   (* load the source compressed colour data *)
  292.     lodsb               (* get the colours to skip              *)
  293.     mov     ah,0
  294.     mov     bx,ax              (* skip colours                         *)
  295.  
  296.     lodsb               (* get the count of colours to set      *)
  297.     mov     ah,0
  298.     mov    cx,ax              (* use it as a loop counter             *)
  299.         mov     dx,Word(DoWait)
  300.  
  301.     call    WritePalEntry
  302.  
  303.     pop     si
  304.     pop     ds
  305.  
  306. end;
  307.  
  308.  
  309. procedure x_transpose_pal_struc(Var CompPalBuff;StartColor:Word;DoWait:Boolean); assembler;
  310. asm
  311.     push    ds
  312.     push    si
  313.     cld
  314.     lds     si,[CompPalBuff] (* load the source compressed colour data *)
  315.     mov     bx,[StartColor]
  316.     mov     [si],bl
  317.     inc     si
  318.     lodsb               (* get the count of colours to set      *)
  319.     mov     ah,0
  320.     mov    cx,ax              (* use it as a loop counter             *)
  321.         mov     dx,Word(DoWait)
  322.  
  323.     call    WritePalEntry
  324.  
  325.     pop  si
  326.     pop  ds
  327. end;
  328.  
  329.  
  330. procedure x_put_pal_raw(Var PalBuff;
  331.                         NumColors,StartColor : Word;
  332.                         DoWait               : Boolean); assembler;
  333. asm
  334.     push ds
  335.     push si
  336.  
  337.     mov  cx,[NumColors]      (* Number of colours to set       *)
  338.     mov  bx,[StartColor]
  339.     lds  si,[PalBuff]        (* ds:si -> palette buffer        *)
  340.         mov  dx,Word(DoWait)
  341.  
  342.         call WritePalEntry
  343.  
  344.     pop  si
  345.     pop  ds
  346. end;
  347.  
  348.  
  349. procedure x_set_rgb(ColorIndex,R,G,B:Byte); assembler;
  350. asm
  351.  
  352.         mov  al,[ColorIndex]
  353.         mov  dx,DAC_WRITE_INDEX  (* Tell DAC what colour index to  *)
  354.         out  dx,al               (* write to                       *)
  355.         mov  dx,DAC_DATA
  356.  
  357.         mov  al,[R]              (* Set the red component          *)
  358.         out  dx,al
  359.         mov  al,[G]              (* Set the green component        *)
  360.         out  dx,al
  361.         mov  al,[B]              (* Set the blue component         *)
  362.         out  dx,al
  363. end;
  364.  
  365. (* Intern asm procedure *)
  366. procedure RotatePalEntry(Direction:Word); assembler;
  367. asm;
  368.     mov     ax,ds                (* copy ds to es                             *)
  369.     mov     es,ax
  370.  
  371.     dec  cx
  372.     mov     bx,cx                (* Multiply cx by 3                          *)
  373.     shl     bx,1
  374.     add  cx,bx
  375.  
  376.     cmp  [Direction],0        (* are we going forward ?                    *)
  377.     jne  @@forward            (* yes - jump (colors move one position back)*)
  378.  
  379.     std                       (* no - set reverse direction                *)
  380.     add  si,cx                (* set si to last byte in palette            *)
  381.     add  si,2
  382.  
  383. @@forward:
  384.     mov     ax,si                (* copy si to di                             *)
  385.     mov     di,ax
  386.  
  387.     lodsb                     (* load first color triplet into regs        *)
  388.     mov  dl,al
  389.     lodsb
  390.     mov  dh,al
  391.     lodsb
  392.     mov  bl,al
  393.  
  394.     rep     movsb                (* move remaining triplets direction indicated *)
  395.                   (* by direction flag                         *)
  396.  
  397.     mov  al,dl                (* write color triplet from regs to last position *)
  398.     stosb
  399.     mov  al,dh
  400.     stosb
  401.     mov  al,bl
  402.     stosb
  403.  
  404.     pop     di
  405.     pop     si
  406.     pop     ds
  407.  
  408. end;
  409.  
  410. procedure x_rot_pal_struc(Var PalBuff;Direction:Word); assembler;
  411. asm
  412.     push ds
  413.     push si
  414.     push di
  415.  
  416.     cld
  417.     lds     si,dword ptr [PalBuff]  (* point ds:si to Palette buffer          *)
  418.     lodsw                        (* al = colorst ot skip, ah = num colors  *)
  419.  
  420.     xor  ch,ch         (* Set the number of palette entries to cycle in cx *)
  421.     mov  cl,ah
  422.  
  423.     push [Direction]
  424.     call RotatePalEntry
  425.  
  426. end;
  427.  
  428.  
  429.  
  430. procedure x_rot_pal_raw(Var PalBuff;Direction,NumColors:Word); assembler;
  431. asm
  432.     push ds
  433.     push si
  434.     push di
  435.  
  436.     cld
  437.     mov     cx,[NumColors]          (* Set the number of palette entries to cycle *)
  438.     lds     si,dword ptr [PalBuff]  (* point ds:si to Palette buffer          *)
  439.  
  440.     push [Direction]
  441.     call RotatePalEntry
  442. end;
  443.  
  444. procedure x_cpcontrast_pal_struc(Var PalSrcBuff,PalDestBuff;Intensity:Byte);  assembler;
  445. asm
  446.     push ds
  447.     push si
  448.     push di
  449.  
  450.     cld
  451.     mov  bh,0ffh
  452.     sub  bh,[Intensity]
  453.     and  bh,07fh            (* Palettes are 7 bit                          *)
  454.     lds     si,dword ptr [PalSrcBuff]  (* point ds:si to Source Palette buffer*)
  455.     les     di,dword ptr [PalDestBuff] (* point ds:si to Source Palette buffer*)
  456.     lodsw                (* al = colorst ot skip, ah = num color*)
  457.     stosw
  458.  
  459.     xor  ch,ch    (* Set the number of palette entries to adjust           *)
  460.     mov  cl,ah    (*                                                       *)
  461.  
  462.     mov  dx,0     (* flag set to 0 if all output palette entries zero      *)
  463. @@MainLoop:
  464.     lodsw
  465.     sub  al,bh               (* adjust intensity and copy RED              *)
  466.     jns  @@DecrementOK_R
  467.     xor  al,al
  468. @@DecrementOK_R:
  469.     sub  ah,bh               (* adjust intensity and copy GREEN            *)
  470.     jns  @@DecrementOK_G
  471.     xor  ah,ah
  472. @@DecrementOK_G:
  473.     or   dx,ax
  474.     or   dl,ah
  475.     stosw
  476.     lodsb
  477.     sub  al,bh               (* adjust intensity and copy BLUE             *)
  478.     jns  @@DecrementOK_B
  479.     xor  al,al
  480. @@DecrementOK_B:
  481.     or   dl,al
  482.     stosb
  483.     loop @@MainLoop
  484.  
  485.     mov  ax,dx
  486.     pop  di
  487.     pop     si
  488.     pop     ds
  489. end;
  490.  
  491.  
  492.  
  493. procedure x_put_contrast_pal_struc(Var CompPalBuff;Intensity:Byte); assembler;
  494. asm
  495.     push    ds
  496.     push    si
  497.     push    di
  498.     cld
  499.  
  500.     mov     bh,0ffh
  501.     sub     bh,[Intensity]
  502.     and     bh,07fh            (* Palettes are 7 bit                   *)
  503.     mov     di,40              (* set the vsync check timer (Vsync     *)
  504.                    (* is tested for at each di'th entry to *)
  505.                    (* prevent snow 40 is otimum for 10     *)
  506.                    (* MHz 286 or greater)                  *)
  507.     lds     si,[CompPalBuff]   (* load the source compressed colour data *)
  508.     lodsb               (* get the colours to skip              *)
  509.     mov     bl,al
  510.  
  511.     lodsb               (* get the count of colours to set      *)
  512.     mov     ah,0
  513.     mov    cx,ax              (* use it as a loop counter             *)
  514.     or      cx,cx
  515.     jz      @@Done
  516.  
  517.     call WaitVsyncStart        (* Wait for vert sync to start            *)
  518.  
  519. @@MainLoop:
  520.         mov  al,bl
  521.     mov  dx,DAC_WRITE_INDEX  (* Tell DAC what colour index to start    *)
  522.     out  dx,al               (* writing from                           *)
  523.     inc  dx                  (* == mov  dx,DAC_DATA                    *)
  524.  
  525.     lodsb                    (* Load each colour component, modify for *)
  526.     sub  al,bh               (* intensity and write to DAC H/Ware      *)
  527.     jns  @@DecrementOK_R
  528.     xor  al,al
  529. @@DecrementOK_R:
  530.     out  dx,al
  531.  
  532.     lodsb
  533.     sub  al,bh
  534.     jns  @@DecrementOK_G
  535.     xor  al,al
  536. @@DecrementOK_G:
  537.     out  dx,al
  538.  
  539.     lodsb
  540.     sub  al,bh
  541.     jns  @@DecrementOK_B
  542.     xor  al,al
  543. @@DecrementOK_B:
  544.     out  dx,al
  545.  
  546.     inc  bl                  (* increment color index                  *)
  547.     dec  di                  (* decrement vsync test flag              *)
  548.     js   @@test_vsync
  549.     loop @@MainLoop
  550.     jmp  @@Done
  551.  
  552.  
  553. @@test_vsync:
  554.     mov     dx,INPUT_STATUS_0
  555.     push    ax               (* save current colour index              *)
  556. @@Wait:
  557.     in      al,dx            (* wait for vsync leading edge pulse      *)
  558.     test    al,08h
  559.     jz      @@Wait
  560.  
  561.     pop     ax               (* restore current colour index           *)
  562.     mov     di,40            (* reset vsync test counter               *)
  563.     loop    @@MainLoop       (* loop for next colour index             *)
  564.  
  565. @@Done:
  566.     sti
  567.     pop  di
  568.     pop  si
  569.     pop  ds
  570.  
  571. end;
  572.  
  573. procedure x_Set_RGB_pal;
  574. var i,j,l,w:Word;
  575. begin;
  576.   fillchar(Work_Pal^,sizeof(Work_Pal),63);
  577.   for i:=0 to 5 do
  578.     for l:=0 to 5 do
  579.       for j:=0 to 6 do begin;
  580.                          w:=i+j*6+l*42;
  581.                          Work_Pal^[w,2]:=12*i+0;
  582.                          Work_Pal^[w,1]:=10*j+0;
  583.                          Work_Pal^[w,0]:=12*l+0;
  584.                        end;
  585.  
  586.   fillchar(Work_Pal^[252,0],3,12);
  587.   fillchar(Work_Pal^[253,0],3,25);
  588.   fillchar(Work_Pal^[254,0],3,50);
  589.   fillchar(Work_Pal^[255,0],3,63);
  590.   x_put_pal_raw(Work_Pal^,256,0,true);
  591. end;
  592.  
  593. procedure x_set_Black_pal;  assembler;
  594. asm;
  595.     mov dx,$3c6
  596.     mov al,$FF
  597.     out dx,al                               (* Port[$3c6]:=$ff; *)
  598.     mov cx,$FF
  599.     mov dx,$3C8
  600. @3: mov al,cl                               (*   for i:=0 to 255 do        *)
  601.     out dx,al                               (*     begin;                  *)
  602.     inc dx                                  (*        Port[$3C8]:=i;       *)
  603.     xor al,al
  604.     out dx,al;                              (* rot    Port[$3c9]:=0;       *)
  605.     out dx,al;                              (* grün   Port[$3c9]:=0;       *)
  606.     out dx,al;                              (* blau   Port[$3c9]:=0;       *)
  607.     dec dx
  608.     loop @3                                (*     end;                    *)
  609. end;
  610.  
  611. procedure X_Pal2Dark(var Colors);  assembler;
  612. var Old_DS:Word;
  613. asm;
  614.     mov  ax,ds
  615.     mov  Old_DS,ax
  616.     mov  bx,65              (* for k=64 downto 0 do                       *)
  617.  
  618. @Loop:Dec  bl
  619.       push bx                    (* AX Rechenwert    BL = Faktor          *)
  620.       les  di,DWord [Colors]      (* ES:DI Pointer to original-palette    *)
  621.       lds  si,dword ptr [Work_Pal](* DS:SI Pointer to Work_Pal-palette    *)
  622.       mov  cx,768                 (* CX Loop-Wert                         *)
  623.  
  624.  @1:  xor  ah,ah
  625.       mov  al,es:[di]
  626.       mul  bl                  (* for i:=0 to 255 do                      *)
  627.       shl  ax,1                (*    for j:=0 to 2 do                     *)
  628.       shl  ax,1                (*         Soft_Pal[i,j]:=                 *)
  629.       mov  ds:[si],ah          (*             Word(Colors[i,j])*k div 64; *)
  630.       inc  di
  631.       inc  si
  632.       loop @1
  633.  
  634.     mov  ax,Old_DS
  635.     mov  ds,ax
  636.     call WaitVsyncStart
  637.  
  638.     lds  si,dword ptr [Work_Pal]
  639.     mov  cx,256            (* NumColor   := 256   *)
  640.     xor  bx,bx             (* StartColor := 0     *)
  641.     xor  dx,dx             (* DoWait     := False *)
  642.  
  643.     call WritePalEntry
  644.     mov  ax,Old_DS
  645.     mov  ds,ax
  646.  
  647.     pop  bx
  648.     cmp  bl,0
  649.     jnz  @Loop
  650.     mov  ax,Old_DS
  651.     mov  ds,ax
  652. end;
  653.  
  654. procedure X_Dark2Pal(var Colors); assembler;
  655. var Old_DS:Word;
  656. asm;
  657.     mov  ax,ds
  658.     mov  Old_DS,ax
  659.     mov   bx,1              (* for k=1 to 64 do                       *)
  660.  
  661. @Loop:Inc bl
  662.       push bx                    (* AX Rechenwert    BL = Faktor          *)
  663.       les  di,DWord [Colors]      (* ES:DI Pointer to original-palette    *)
  664.       lds  si,dword ptr [Work_Pal](* DS:SI Pointer to Work_Pal-palette    *)
  665.       mov  cx,768                 (* CX Loop-Wert                         *)
  666.  
  667.  @1:  xor  ah,ah
  668.       mov  al,es:[di]
  669.       mul  bl                  (* for i:=0 to 255 do                      *)
  670.       shl  ax,1                (*    for j:=0 to 2 do                     *)
  671.       shl  ax,1                (*         Soft_Pal[i,j]:=                 *)
  672.       mov  ds:[si],ah          (*             Word(Colors[i,j])*k div 64; *)
  673.       inc  di
  674.       inc  si
  675.       loop @1
  676.  
  677.     mov  ax,Old_DS
  678.     mov  ds,ax
  679.     call WaitVsyncStart
  680.  
  681.     lds  si,dword ptr [Work_Pal]
  682.     mov  cx,256            (* NumColor   := 256   *)
  683.     xor  bx,bx             (* StartColor := 0     *)
  684.     xor  dx,dx             (* DoWait     := False *)
  685.  
  686.     call WritePalEntry
  687.     mov  ax,Old_DS
  688.     mov  ds,ax
  689.  
  690.     pop bx
  691.     cmp bl,64
  692.     jne @Loop
  693. end;
  694.  
  695.  
  696. begin;
  697.   GetMem(Work_Pal,sizeof(palette)+8);
  698. end.
  699.  
  700.  
  701.