palette.ppi 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,97 by the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. { GetRGBPalette,SetRGBPalette,SetAllPalette,GetPalette }
  12. { Bei saemtlichen Palettefunktionen nicht auf Grafikmodus testen }
  13. { funktionieren auch im TextModus }
  14. procedure SetAllPalette(var Palette:PaletteType);
  15. begin
  16. asm
  17. movl Palette,%esi
  18. movb $767,%ecx
  19. xorl %eax,%eax
  20. movl $2,%ebx
  21. movw $0x03c8,%dx
  22. outb %al,%dx
  23. incw %dx
  24. sp_loop:
  25. movb (%esi,%ebx,1),%al
  26. shrb $2,%al
  27. outb %al,%dx
  28. incl %ebx
  29. decl %ecx
  30. jnz sp_loop
  31. end;
  32. end;
  33. procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
  34. begin
  35. asm
  36. movw $0x3c8,%DX
  37. movb ColorNum,%al
  38. outb %AL,%DX
  39. incw %DX
  40. movb RedValue,%al
  41. shrb $2,%al
  42. outb %AL,%DX
  43. movb GreenValue,%al
  44. shrb $2,%al
  45. outb %AL,%DX
  46. movb BlueValue,%al
  47. shrb $2,%al
  48. outb %AL,%DX
  49. end;
  50. end;
  51. procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
  52. begin
  53. asm
  54. movw $0x3c7,%DX
  55. movb ColorNum,%ax
  56. outb %AL,%DX
  57. addw $2,%DX
  58. xorl %eax,%eax
  59. inb %DX,%AL
  60. shlb $2,%al
  61. movb %al,RedValue
  62. inb %DX,%AL
  63. shlb $2,%al
  64. movb %al,GreenValue
  65. inb %DX,%AL
  66. shlb $2,%al
  67. movb %al,BlueValue
  68. end;
  69. end;
  70. procedure Getpalette(var Palette:PaletteType);
  71. begin
  72. asm
  73. movl palette,%edi
  74. movw $0,(%edi)
  75. testw $2,_BYTESPERPIXEL
  76. jnz gp_end
  77. movw $0x100,(%edi)
  78. movl $767,%ecx
  79. xorl %eax,%eax
  80. movl $2,%ebx
  81. movl $0x03c7,%dx
  82. outb %al,%dx
  83. addw $2,%dx
  84. gp_loop:
  85. inb %dx,%al
  86. shlb $2,%al
  87. movb %al,(%edi,%ebx,1)
  88. incl %ebx
  89. decl %ecx
  90. jnz gp_loop
  91. gp_end:
  92. end;
  93. end;
  94. {
  95. $Log$
  96. Revision 1.1 1998-03-25 11:18:42 root
  97. Initial revision
  98. Revision 1.3 1998/01/26 11:58:29 michael
  99. + Added log at the end
  100. Working file: rtl/dos/ppi/palette.ppi
  101. description:
  102. ----------------------------
  103. revision 1.2
  104. date: 1997/12/01 12:21:32; author: michael; state: Exp; lines: +13 -1
  105. + added copyright reference in header.
  106. ----------------------------
  107. revision 1.1
  108. date: 1997/11/27 08:33:51; author: michael; state: Exp;
  109. Initial revision
  110. ----------------------------
  111. revision 1.1.1.1
  112. date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
  113. FPC RTL CVS start
  114. =============================================================================
  115. }