diff --git a/packages/ami-extra/src/muihelper.pas b/packages/ami-extra/src/muihelper.pas index 0bd2e80637..d13566775b 100644 --- a/packages/ami-extra/src/muihelper.pas +++ b/packages/ami-extra/src/muihelper.pas @@ -439,12 +439,16 @@ end; procedure MH_Set(Obj: PObject_; Tag, Data: PtrUInt); begin + {$if not defined(AMIGA_V1_2_ONLY)} SetAttrs(Obj, [Tag, Data, TAG_END]); + {$endif} end; function MH_Get(Obj: PObject_; Tag: PtrUInt): PtrUInt; begin + {$if not defined(AMIGA_V1_2_ONLY)} GetAttr(Tag, Obj, MH_Get); + {$endif} end; procedure MH_SetMutex(Obj: PObject_; n: Integer); @@ -1635,13 +1639,21 @@ end; // ************************************************************************ function MH_NewObject(ClassPtr: PIClass; ClassID: PChar; const Tags: array of PtrUInt): APTR; begin + {$if defined(AMIGA_V1_2_ONLY)} + MH_NewObject := nil; + {$else} MH_NewObject := NewObject(ClassPtr, ClassID, Tags); + {$endif} end; function MH_NewObject(var Obj; ClassPtr: PIClass; ClassID: PChar; const Tags: array of PtrUInt): APTR; begin + {$if defined(AMIGA_V1_2_ONLY)} + MH_NewObject := nil; + {$else} PObject_(Obj) := NewObject(ClassPtr, ClassID, Tags); MH_NewObject := PObject_(Obj); + {$endif} end; // deprecated but widely used macros diff --git a/packages/amunits/src/coreunits/agraphics.pas b/packages/amunits/src/coreunits/agraphics.pas index 5bca70fb7b..e8a9174e90 100644 --- a/packages/amunits/src/coreunits/agraphics.pas +++ b/packages/amunits/src/coreunits/agraphics.pas @@ -2250,6 +2250,120 @@ const var GfxBase : PGfxBase = nil; + +{$if defined(AMIGA_V1_2_ONLY)} +FUNCTION AllocRaster(width : ULONG location 'd0'; height : ULONG location 'd1') : TPlanePtr; syscall GfxBase 492; +PROCEDURE FreeRaster(p : TPlanePtr location 'a0'; width : ULONG location 'd0'; height : ULONG location 'd1'); syscall GfxBase 498; +PROCEDURE InitBitMap(bitMap : pBitMap location 'a0'; depth : LONGINT location 'd0'; width : LONGINT location 'd1'; height : LONGINT location 'd2'); syscall GfxBase 390; +PROCEDURE InitRastPort(rp : pRastPort location 'a1'); syscall GfxBase 198; +PROCEDURE SetAPen(rp : pRastPort location 'a1'; pen : ULONG location 'd0'); syscall GfxBase 342; +PROCEDURE SetBPen(rp : pRastPort location 'a1'; pen : ULONG location 'd0'); syscall GfxBase 348; +PROCEDURE SetDrMd(rp : pRastPort location 'a1'; drawMode : ULONG location 'd0'); syscall GfxBase 354; +PROCEDURE SetRast(rp : pRastPort location 'a1'; pen : ULONG location 'd0'); syscall GfxBase 234; + +PROCEDURE ClearEOL(rp : pRastPort location 'a1'); syscall GfxBase 042; +PROCEDURE ClearScreen(rp : pRastPort location 'a1'); syscall GfxBase 048; +PROCEDURE Draw(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1'); syscall GfxBase 246; +PROCEDURE DrawEllipse(rp : pRastPort location 'a1'; xCenter : LONGINT location 'd0'; yCenter : LONGINT location 'd1'; a : LONGINT location 'd2'; b : LONGINT location 'd3'); syscall GfxBase 180; +PROCEDURE gfxMove(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1'); syscall GfxBase 240; +PROCEDURE PolyDraw(rp : pRastPort location 'a1'; count : LONGINT location 'd0';const polyTable : PSmallInt location 'a0'); syscall GfxBase 336; +FUNCTION ReadPixel(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : ULONG; syscall GfxBase 318; +PROCEDURE ScrollRaster(rp : pRastPort location 'a1'; dx : LONGINT location 'd0'; dy : LONGINT location 'd1'; xMin : LONGINT location 'd2'; yMin : LONGINT location 'd3'; xMax : LONGINT location 'd4'; yMax : LONGINT location 'd5'); syscall GfxBase 396; +FUNCTION GfxText(rp : pRastPort location 'a1';const string_ : pCHAR location 'a0'; count : ULONG location 'd0') : LONGINT; syscall GfxBase 060; +FUNCTION TextLength(rp : pRastPort location 'a1';const string_ : pCHAR location 'a0'; count : ULONG location 'd0') : smallint; syscall GfxBase 054; +FUNCTION WritePixel(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : LONGINT; syscall GfxBase 324; + +FUNCTION AreaDraw(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : LONGINT; syscall GfxBase 258; +FUNCTION AreaEllipse(rp : pRastPort location 'a1'; xCenter : LONGINT location 'd0'; yCenter : LONGINT location 'd1'; a : LONGINT location 'd2'; b : LONGINT location 'd3') : LONGINT; syscall GfxBase 186; +FUNCTION AreaEnd(rp : pRastPort location 'a1') : LONGINT; syscall GfxBase 264; +FUNCTION AreaMove(rp : pRastPort location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : LONGINT; syscall GfxBase 252; +FUNCTION Flood(rp : pRastPort location 'a1'; mode : ULONG location 'd2'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : LongBool; syscall GfxBase 330; +PROCEDURE InitArea(areaInfo : pAreaInfo location 'a0'; vectorBuffer : POINTER location 'a1'; maxVectors : LONGINT location 'd0'); syscall GfxBase 282; +FUNCTION InitTmpRas(tmpRas : pTmpRas location 'a0'; buffer : Pointer location 'a1'; size : LONGINT location 'd0') : pTmpRas; syscall GfxBase 468; +PROCEDURE RectFill(rp : pRastPort location 'a1'; xMin : LONGINT location 'd0'; yMin : LONGINT location 'd1'; xMax : LONGINT location 'd2'; yMax : LONGINT location 'd3'); syscall GfxBase 306; + +PROCEDURE FreeColorMap(colorMap : pColorMap location 'a0'); syscall GfxBase 576; +FUNCTION GetColorMap(entries : LONGINT location 'd0') : pColorMap; syscall GfxBase 570; +FUNCTION GetRGB4(colorMap : pColorMap location 'a0'; entry : LONGINT location 'd0') : ULONG; syscall GfxBase 582; +PROCEDURE LoadRGB4(vp : pViewPort location 'a0';const colors : pWord location 'a1'; count : LONGINT location 'd0'); syscall GfxBase 192; +PROCEDURE SetRGB4(vp : pViewPort location 'a0'; index : LONGINT location 'd0'; red : ULONG location 'd1'; green : ULONG location 'd2'; blue : ULONG location 'd3'); syscall GfxBase 288; +PROCEDURE SetRGB4CM(colorMap : pColorMap location 'a0'; index : LONGINT location 'd0'; red : ULONG location 'd1'; green : ULONG location 'd2'; blue : ULONG location 'd3'); syscall GfxBase 630; + +FUNCTION BltBitMap(const srcBitMap : pBitMap location 'a0'; xSrc : LONGINT location 'd0'; ySrc : LONGINT location 'd1'; destBitMap : pBitMap location 'a1'; xDest : LONGINT location 'd2'; yDest : LONGINT location 'd3'; xSize : LONGINT location 'd4'; ySize : LONGINT location 'd5'; minterm : ULONG location 'd6'; mask : ULONG location 'd7'; tempA : pCHAR location 'a2') : LONGINT; syscall GfxBase 030; +PROCEDURE BltBitMapRastPort(const srcBitMap : pBitMap location 'a0'; xSrc : LONGINT location 'd0'; ySrc : LONGINT location 'd1'; destRP : pRastPort location 'a1'; xDest : LONGINT location 'd2'; yDest : LONGINT location 'd3'; xSize : LONGINT location 'd4'; ySize : LONGINT location 'd5'; minterm : ULONG location 'd6'); syscall GfxBase 606; +PROCEDURE BltClear(memBlock : pointer location 'a1'; byteCount : ULONG location 'd0'; flags : ULONG location 'd1'); syscall GfxBase 300; +PROCEDURE BltMaskBitMapRastPort(const srcBitMap : pBitMap location 'a0'; xSrc : LONGINT location 'd0'; ySrc : LONGINT location 'd1'; destRP : pRastPort location 'a1'; xDest : LONGINT location 'd2'; yDest : LONGINT location 'd3'; xSize : LONGINT location 'd4'; ySize : LONGINT location 'd5'; minterm : ULONG location 'd6';const bltMask : pCHAR location 'a2'); syscall GfxBase 636; +PROCEDURE BltPattern(rp : pRastPort location 'a1';const mask : pCHAR location 'a0'; xMin : LONGINT location 'd0'; yMin : LONGINT location 'd1'; xMax : LONGINT location 'd2'; yMax : LONGINT location 'd3'; maskBPR : ULONG location 'd4'); syscall GfxBase 312; +PROCEDURE BltTemplate(const source : pWORD location 'a0'; xSrc : LONGINT location 'd0'; srcMod : LONGINT location 'd1'; destRP : pRastPort location 'a1'; xDest : LONGINT location 'd2'; yDest : LONGINT location 'd3'; xSize : LONGINT location 'd4'; ySize : LONGINT location 'd5'); syscall GfxBase 036; +PROCEDURE ClipBlit(srcRP : pRastPort location 'a0'; xSrc : LONGINT location 'd0'; ySrc : LONGINT location 'd1'; destRP : pRastPort location 'a1'; xDest : LONGINT location 'd2'; yDest : LONGINT location 'd3'; xSize : LONGINT location 'd4'; ySize : LONGINT location 'd5'; minterm : ULONG location 'd6'); syscall GfxBase 552; +PROCEDURE DisownBlitter; syscall GfxBase 462; +PROCEDURE OwnBlitter; syscall GfxBase 456; +PROCEDURE QBlit(blit : pbltnode location 'a1'); syscall GfxBase 276; +PROCEDURE QBSBlit(blit : pbltnode location 'a1'); syscall GfxBase 294; +PROCEDURE WaitBlit; syscall GfxBase 228; + +PROCEDURE CBump(copList : pUCopList location 'a1'); syscall GfxBase 366; +PROCEDURE CMove(copList : pUCopList location 'a1'; destination : POINTER location 'a0'; data : LONGINT location 'd1'); syscall GfxBase 372; +PROCEDURE CWait(copList : pUCopList location 'a1'; v : LONGINT location 'd0'; h : LONGINT location 'd1'); syscall GfxBase 378; +PROCEDURE FreeCopList(copList : pCopList location 'a0'); syscall GfxBase 546; +PROCEDURE FreeCprList(cprList : pcprlist location 'a0'); syscall GfxBase 564; +PROCEDURE FreeVPortCopLists(vp : pViewPort location 'a0'); syscall GfxBase 540; +PROCEDURE InitView(view : pView location 'a1'); syscall GfxBase 360; +PROCEDURE InitVPort(vp : pViewPort location 'a0'); syscall GfxBase 204; +PROCEDURE LoadView(view : pView location 'a1'); syscall GfxBase 222; +FUNCTION MakeVPort(view : pView location 'a0'; vp : pViewPort location 'a1') : ULONG; syscall GfxBase 216; +FUNCTION MrgCop(view : pView location 'a1') : ULONG; syscall GfxBase 210; +PROCEDURE ScrollVPort(vp : pViewPort location 'a0'); syscall GfxBase 588; +FUNCTION UCopperListInit(uCopList : pUCopList location 'a0'; n : LONGINT location 'd0') : pCopList; syscall GfxBase 594; +FUNCTION VBeamPos : LONGINT; syscall GfxBase 384; +PROCEDURE WaitBOVP(vp : pViewPort location 'a0'); syscall GfxBase 402; +PROCEDURE WaitTOF; syscall GfxBase 270; + +PROCEDURE AndRectRegion(region : pRegion location 'a0';const rectangle : pRectangle location 'a1'); syscall GfxBase 504; +FUNCTION AndRegionRegion(const srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : LongBool; syscall GfxBase 624; +FUNCTION AttemptLockLayerRom(layer : pLayer location 'a5') : LongBool; syscall GfxBase 654; +FUNCTION ClearRectRegion(region : pRegion location 'a0';const rectangle : pRectangle location 'a1') : LongBool; syscall GfxBase 522; +PROCEDURE ClearRegion(region : pRegion location 'a0'); syscall GfxBase 528; +PROCEDURE CopySBitMap(layer : pLayer location 'a0'); syscall GfxBase 450; +PROCEDURE DisposeRegion(region : pRegion location 'a0'); syscall GfxBase 534; +PROCEDURE LockLayerRom(layer : pLayer location 'a5'); syscall GfxBase 432; +FUNCTION NewRegion : pRegion; syscall GfxBase 516; +FUNCTION OrRectRegion(region : pRegion location 'a0';const rectangle : pRectangle location 'a1') : LongBool; syscall GfxBase 510; +FUNCTION OrRegionRegion(const srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : LongBool; syscall GfxBase 612; +PROCEDURE SyncSBitMap(layer : pLayer location 'a0'); syscall GfxBase 444; +PROCEDURE UnlockLayerRom(layer : pLayer location 'a5'); syscall GfxBase 438; +FUNCTION XorRectRegion(region : pRegion location 'a0';const rectangle : pRectangle location 'a1') : LongBool; syscall GfxBase 558; +FUNCTION XorRegionRegion(const srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : LongBool; syscall GfxBase 618; + +PROCEDURE AddFont(textFont : pTextFont location 'a1'); syscall GfxBase 480; +PROCEDURE AskFont(rp : pRastPort location 'a1'; textAttr : pTextAttr location 'a0'); syscall GfxBase 474; +FUNCTION AskSoftStyle(rp : pRastPort location 'a1') : ULONG; syscall GfxBase 084; +PROCEDURE CloseFont(textFont : pTextFont location 'a1'); syscall GfxBase 078; +FUNCTION OpenFont(textAttr : pTextAttr location 'a0') : pTextFont; syscall GfxBase 072; +PROCEDURE RemFont(textFont : pTextFont location 'a1'); syscall GfxBase 486; +FUNCTION SetFont(rp : pRastPort location 'a1';const textFont : pTextFont location 'a0') : LONGINT; syscall GfxBase 066; +FUNCTION SetSoftStyle(rp : pRastPort location 'a1'; style : ULONG location 'd0'; enable : ULONG location 'd1') : ULONG; syscall GfxBase 090; + +PROCEDURE AddAnimOb(anOb : pAnimOb location 'a0'; anKey : ppAnimOb location 'a1'; rp : pRastPort location 'a2'); syscall GfxBase 156; +PROCEDURE AddBob(bob : pBob location 'a0'; rp : pRastPort location 'a1'); syscall GfxBase 096; +PROCEDURE AddVSprite(vSprite : pVSprite location 'a0'; rp : pRastPort location 'a1'); syscall GfxBase 102; +PROCEDURE Animate(anKey : ppAnimOb location 'a0'; rp : pRastPort location 'a1'); syscall GfxBase 162; +PROCEDURE ChangeSprite(vp : pViewPort location 'a0'; sprite : pSimpleSprite location 'a1'; newData : pWORD location 'a2'); syscall GfxBase 420; +PROCEDURE DoCollision(rp : pRastPort location 'a1'); syscall GfxBase 108; +PROCEDURE DrawGList(rp : pRastPort location 'a1'; vp : pViewPort location 'a0'); syscall GfxBase 114; +PROCEDURE FreeGBuffers(anOb : pAnimOb location 'a0'; rp : pRastPort location 'a1'; flag : LONGINT location 'd0'); syscall GfxBase 600; +PROCEDURE FreeSprite(num : LONGINT location 'd0'); syscall GfxBase 414; +FUNCTION GetGBuffers(anOb : pAnimOb location 'a0'; rp : pRastPort location 'a1'; flag : LONGINT location 'd0') : LongBool; syscall GfxBase 168; +FUNCTION GetSprite(sprite : pSimpleSprite location 'a0'; num : LONGINT location 'd0') : smallint; syscall GfxBase 408; +PROCEDURE InitGels(head : pVSprite location 'a0'; tail : pVSprite location 'a1'; gelsInfo : pGelsInfo location 'a2'); syscall GfxBase 120; +PROCEDURE InitGMasks(anOb : pAnimOb location 'a0'); syscall GfxBase 174; +PROCEDURE InitMasks(vSprite : pVSprite location 'a0'); syscall GfxBase 126; +PROCEDURE MoveSprite(vp : pViewPort location 'a0'; sprite : pSimpleSprite location 'a1'; x : LONGINT location 'd0'; y : LONGINT location 'd1'); syscall GfxBase 426; +PROCEDURE RemIBob(bob : pBob location 'a0'; rp : pRastPort location 'a1'; vp : pViewPort location 'a2'); syscall GfxBase 132; +PROCEDURE RemVSprite(vSprite : pVSprite location 'a0'); syscall GfxBase 138; +PROCEDURE SetCollision(num : ULONG location 'd0'; routine : tPROCEDURE location 'a0'; gelsInfo : pGelsInfo location 'a1'); syscall GfxBase 144; +PROCEDURE SortGList(rp : pRastPort location 'a1'); syscall GfxBase 150; +{$else} PROCEDURE AddAnimOb(anOb : pAnimOb location 'a0'; anKey : ppAnimOb location 'a1'; rp : pRastPort location 'a2'); syscall GfxBase 156; PROCEDURE AddBob(bob : pBob location 'a0'; rp : pRastPort location 'a1'); syscall GfxBase 096; PROCEDURE AddFont(textFont : pTextFont location 'a1'); syscall GfxBase 480; @@ -2424,6 +2538,9 @@ function ObtainBestPen(cm : pColorMap; r : ULONG; g : ULONG; b : ULONG; Const ar procedure SetRPAttrs(rp : pRastPort; Const argv : array of PtrUInt); function VideoControlTags(colorMap : pColorMap; Const argv : array of PtrUInt) : LongWord; function WeighTAMatchTags(reqTextAttr : pTextAttr; targetTextAttr : pTextAttr; Const argv : array of PtrUInt) : smallint; +PROCEDURE SafeSetOutlinePen(w : pRastPort; c : byte); +PROCEDURE SafeSetWriteMask( w : pRastPort ; m : smallint ) ; +{$endif} { gfxmacros } @@ -2433,9 +2550,7 @@ PROCEDURE SetAfPt(w: pRastPort;p: Pointer; n: Byte); PROCEDURE SetDrPt(w: pRastPort;p: Word); PROCEDURE SetOPen(w: pRastPort;c: Byte); PROCEDURE SetWrMsk(w: pRastPort; m: Byte); - -PROCEDURE SafeSetOutlinePen(w : pRastPort; c : byte); -PROCEDURE SafeSetWriteMask( w : pRastPort ; m : smallint ) ; +procedure RemBob(Bob: PBob); inline; PROCEDURE OFF_DISPLAY (cust: pCustom); PROCEDURE ON_DISPLAY (cust: pCustom); @@ -2449,8 +2564,85 @@ function AreaCircle(Rp: PRastPort; xCenter, yCenter, r: SmallInt): LongWord; inl function RasSize(w, h: Word): Integer; +function CreateBitMap(Width, Height, Depth: Integer): PBitmap; +procedure DestroyBitMap(MyBM: PBitmap; Width, Height, Depth: Integer); + +{$if defined(AMIGA_V1_2_ONLY)} +procedure SetABPenDrMd(Rp: PRastPort; APen, BPen, Drawmode: LongWord); inline; +function AllocBitMap(SizeX, SizeY, Depth, Flags: LongWord; friend_bitmap: PBitMap): PBitMap; +procedure FreeBitMap(Bm: PBitMap); +function GetBitMapAttr(Bm: PBitMap; AttrNum: LongWord): LongWord; +{$endif} + + IMPLEMENTATION +procedure RemBob(Bob: PBob); +begin + Bob^.Flags := Bob^.Flags or BOBSAWAY; +end; + +function CreateBitMap(Width, Height, Depth: Integer): PBitmap; +var + MyBM: PBitmap; + i: Integer; +begin + MyBM := ExecAllocMem(SizeOf(TBitMap), MEMF_CLEAR or MEMF_PUBLIC); + for i := 0 to Depth - 1 do + MyBM^.Planes[i] := AllocRaster(Width, Height); + for i := Depth to 7 do + MyBM^.Planes[i] := nil; + MyBM^.Flags := MyBM^.Flags or BMF_STANDARD; + CreateBitMap := MyBM; +end; + +procedure DestroyBitMap(MyBM: PBitmap; Width, Height, Depth: Integer); +var + i: Integer; +begin + if MyBM <> nil then + begin + for i := 0 to Depth - 1 do + if MyBM^.Planes[i] <> nil then + FreeRaster(MyBM^.Planes[i], Width, Height); + FreeMem(MyBM, SizeOf(TBitMap)); + end; +end; + + +{$if defined(AMIGA_V1_2_ONLY)} +procedure SetABPenDrMd(Rp: PRastPort; APen, BPen, Drawmode: LongWord); +begin + SetAPen(RP, APen); + SetBPen(RP, BPen); + SetDrMd(RP, DrawMode); +end; + +function AllocBitMap(SizeX, SizeY, Depth, Flags: LongWord; friend_bitmap: PBitMap): PBitMap; +begin + AllocBitMap := CreateBitmap(SizeX, SizeY, Depth); +end; + +procedure FreeBitMap(Bm: PBitMap); +begin + if bm <> nil then + DestroyBitMap(bm, Bm^.BytesPerRow * 8, bm^.Rows, bm^.Depth); +end; + +function GetBitMapAttr(Bm: PBitMap; AttrNum: LongWord): LongWord; +begin + case AttrNum of + BMA_HEIGHT: GetBitMapAttr := bm^.Rows; + BMA_WIDTH: GetBitMapAttr := bm^.BytesPerRow * 8; + BMA_DEPTH: GetBitMapAttr := bm^.Depth; + BMA_FLAGS: GetBitMapAttr := bm^.Flags and (BMF_DISPLAYABLE or BMF_INTERLEAVED or BMF_STANDARD); + else + GetBitMapAttr := 0; + end; +end; +{$endif} + +{$if not defined(AMIGA_V1_2_ONLY)} function AllocSpriteData(bm : pBitMap; Const argv : array of PtrUInt) : pExtSprite; begin AllocSpriteData := AllocSpriteDataA(bm,@argv); @@ -2501,6 +2693,26 @@ begin WeighTAMatchTags := WeighTAMatch(reqTextAttr,targetTextAttr,@argv); end; +PROCEDURE SafeSetOutlinePen(w : pRastPort; c : byte); +begin + IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN begin + w^.AOlPen := c; + w^.Flags := w^.Flags OR AREAOUTLINE; + END ELSE begin + c := SetOutlinePen(w,c); + END; +END; + +PROCEDURE SafeSetWriteMask( w : pRastPort ; m : smallint ) ; + VAR x : smallint ; +BEGIN + IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN w^.Mask := BYTE(m) + ELSE x := SetWriteMask( w, m ); +END; + + +{$endif} + PROCEDURE BNDRYOFF (w: pRastPort); BEGIN WITH w^ DO BEGIN @@ -2549,22 +2761,6 @@ BEGIN w^.Mask := m; END; -PROCEDURE SafeSetOutlinePen(w : pRastPort; c : byte); -begin - IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN begin - w^.AOlPen := c; - w^.Flags := w^.Flags OR AREAOUTLINE; - END ELSE begin - c := SetOutlinePen(w,c); - END; -END; - -PROCEDURE SafeSetWriteMask( w : pRastPort ; m : smallint ) ; - VAR x : smallint ; -BEGIN - IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN w^.Mask := BYTE(m) - ELSE x := SetWriteMask( w, m ); -END; PROCEDURE OFF_DISPLAY (cust: pCustom); BEGIN diff --git a/packages/amunits/src/coreunits/amigados.pas b/packages/amunits/src/coreunits/amigados.pas index e40e5adec1..8c64b51dfb 100644 --- a/packages/amunits/src/coreunits/amigados.pas +++ b/packages/amunits/src/coreunits/amigados.pas @@ -1575,7 +1575,43 @@ CONST { tags for NewLoadSeg } { no tags are defined yet for NewLoadSeg } +{$if defined(AMIGA_V1_2_ONLY)} +PROCEDURE DOSClose(file_ : BPTR location 'd1'); syscall _DOSBase 036; +FUNCTION DOSOpen(const name : pCHAR location 'd1'; accessMode : LONGINT location 'd2') : BPTR; syscall _DOSBase 030; +FUNCTION DOSRead(file_ : BPTR location 'd1'; buffer : POINTER location 'd2'; length : LONGINT location 'd3') : LONGINT; syscall _DOSBase 042; +FUNCTION DOSSeek(file_ : BPTR location 'd1'; position : LONGINT location 'd2'; offset : LONGINT location 'd3') : LONGINT; syscall _DOSBase 066; +FUNCTION DOSWrite(file_ : BPTR location 'd1'; buffer : POINTER location 'd2'; length : LONGINT location 'd3') : LONGINT; syscall _DOSBase 048; +FUNCTION CreateDir(const name : pCHAR location 'd1') : BPTR; syscall _DOSBase 120; +FUNCTION CurrentDir(lock : BPTR location 'd1') : BPTR; syscall _DOSBase 126; +FUNCTION DOSDeleteFile(const name : STRPTR location 'd1') : LongBool; syscall _DOSBase 072; +FUNCTION Examine(lock : BPTR location 'd1'; fileInfoBlock : pFileInfoBlock location 'd2') : LongBool; syscall _DOSBase 102; +FUNCTION ExNext(lock : BPTR location 'd1'; fileInfoBlock : pFileInfoBlock location 'd2') : LongBool; syscall _DOSBase 108; +FUNCTION Info(lock : BPTR location 'd1'; parameterBlock : pInfoData location 'd2') : LongBool; syscall _DOSBase 114; +FUNCTION ParentDir(lock : BPTR location 'd1') : BPTR; syscall _DOSBase 210; +FUNCTION DOSRename(const oldName : STRPTR location 'd1';const newName : STRPTR location 'd2') : LongBool; syscall _DOSBase 078; +FUNCTION SetComment(const name : pCHAR location 'd1';const comment : pCHAR location 'd2') : LongBool; syscall _DOSBase 180; +FUNCTION SetProtection(const name : pCHAR location 'd1'; protect : LONGINT location 'd2') : LongBool; syscall _DOSBase 186; + +FUNCTION DupLock(lock : BPTR location 'd1') : BPTR; syscall _DOSBase 096; +FUNCTION DOSInput : BPTR; syscall _DOSBase 054; +FUNCTION IoErr : LONGINT; syscall _DOSBase 132; +FUNCTION IsInteractive(file_ : BPTR location 'd1') : LongBool; syscall _DOSBase 216; +FUNCTION Lock(const name : pCHAR location 'd1'; type_ : LONGINT location 'd2') : LONGINT; syscall _DOSBase 084; +FUNCTION DOSOutput : BPTR; syscall _DOSBase 060; +PROCEDURE UnLock(lock : BPTR location 'd1'); syscall _DOSBase 090; + +FUNCTION CreateProc(const name : pCHAR location 'd1'; pri : LONGINT location 'd2'; segList : BPTR location 'd3'; stackSize : LONGINT location 'd4') : pMsgPort; syscall _DOSBase 138; +PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192; +PROCEDURE DOSDelay(timeout : LONGINT location 'd1'); syscall _DOSBase 198; +FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174; +PROCEDURE DOSExit(returnCode : LONGINT location 'd1'); syscall _DOSBase 144; +FUNCTION WaitForChar(file_ : BPTR location 'd1'; timeout : LONGINT location 'd2') : LongBool; syscall _DOSBase 204; + +FUNCTION Execute(const string_ : pCHAR location 'd1'; file_ : BPTR location 'd2'; file2 : BPTR location 'd3') : LongBool; syscall _DOSBase 222; +FUNCTION LoadSeg(const name : pCHAR location 'd1') : LONGINT; syscall _DOSBase 150; +PROCEDURE UnLoadSeg(seglist : BPTR location 'd1'); syscall _DOSBase 156; +{$else} PROCEDURE AbortPkt(port : pMsgPort location 'd1'; pkt : pDosPacket location 'd2'); syscall _DOSBase 264; FUNCTION AddBuffers(const name : pCHAR location 'd1'; number : LONGINT location 'd2') : LongBool; syscall _DOSBase 732; FUNCTION AddDosEntry(dlist : pDosList location 'd1') : LongBool; syscall _DOSBase 678; @@ -1739,10 +1775,13 @@ FUNCTION VPrintf(const format : pCHAR location 'd1'; const argarray : PLongInt l FUNCTION WaitForChar(file_ : BPTR location 'd1'; timeout : LONGINT location 'd2') : LongBool; syscall _DOSBase 204; FUNCTION WaitPkt : pDosPacket; syscall _DOSBase 252; FUNCTION WriteChars(const buf : pCHAR location 'd1'; buflen : ULONG location 'd2') : LONGINT; syscall _DOSBase 942; +{$endif} + FUNCTION BADDR(bval :BPTR): POINTER; FUNCTION MKBADDR(adr: Pointer): BPTR; +{$if not defined(AMIGA_V1_2_ONLY)} // var args version FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER; FUNCTION CreateNewProcTags(Const argv : Array of PtrUInt) : pProcess; @@ -1819,6 +1858,7 @@ FUNCTION SplitName(const name : string; seperator : ULONG; buf : pCHAR; oldpos : FUNCTION StrToLong(const string_ : string; VAR value : LONGINT) : LONGINT; FUNCTION SystemTagList(const command : string;const tags : pTagItem) : LONGINT; FUNCTION DOSSystem(const command : string;const tags : pTagItem) : LONGINT; +{$endif} IMPLEMENTATION @@ -1832,7 +1872,7 @@ FUNCTION MKBADDR(adr : POINTER): BPTR; inline; BEGIN MKBADDR := BPTR( PTRUINT(adr) shr 2); END; - +{$if not defined(AMIGA_V1_2_ONLY)} FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER; begin AllocDosObjectTags := AllocDosObjectTagList(type_, @argv); @@ -2192,7 +2232,7 @@ FUNCTION DOSSystem(const command : string;const tags : pTagItem) : LONGINT; begin DOSSystem := DOSSystem(PChar(RawByteString(command)),tags); end; - +{$endif} END. (* UNIT DOS *) diff --git a/packages/amunits/src/coreunits/amigalib.pas b/packages/amunits/src/coreunits/amigalib.pas index 0a721605fc..ca26d1c092 100644 --- a/packages/amunits/src/coreunits/amigalib.pas +++ b/packages/amunits/src/coreunits/amigalib.pas @@ -73,6 +73,7 @@ function CreateTask (name: STRPTR; pri: longint; procedure DeleteTask (task: pTask); inline; procedure NewList (list: pList); inline; +{$if not defined(AMIGA_V1_2_ONLY)} // moved to commodities, use them from there {* Commodities support functions from amiga.lib *} procedure FreeIEvents (events: pInputEvent); inline; @@ -99,6 +100,7 @@ function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong; inline; function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong; inline; function DoMethod(obj: PObject_; Params: array of DWord): LongWord; inline; +{$endif} // moved to utility, use them from there procedure HookEntry; @@ -256,6 +258,7 @@ begin CxTranslate := Commodities.CxTranslate(ie) end; +{$if not defined(AMIGA_V1_2_ONLY)} function DoMethodA(obj : pObject_; msg : APTR): ulong; inline; begin DoMethodA := Intuition.DoMethodA(obj, msg); @@ -280,7 +283,7 @@ function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong; inline; begin SetSuperAttrsA := Intuition.SetSuperAttrsA(cl, obj, msg); end; - +{$endif} { Do *NOT* change this to nostackframe! } { The compiler will build a stackframe with link/unlk. So that will actually correct the stackpointer for both Pascal/StdCall and Cdecl functions, so the stackpointer @@ -333,7 +336,9 @@ begin end; end; end; + {$if not defined(AMIGA_V1_2_ONLY)} VPrintf(Fmtstr,@argarray[0]); + {$endif} end; procedure printf(Fmtstr : string; const Args : array of const); diff --git a/packages/amunits/src/coreunits/exec.pas b/packages/amunits/src/coreunits/exec.pas index 433c3d07e2..539f98e881 100644 --- a/packages/amunits/src/coreunits/exec.pas +++ b/packages/amunits/src/coreunits/exec.pas @@ -1176,6 +1176,111 @@ CONST var ExecBase: PExecBase absolute _ExecBase; +{$if defined(AMIGA_V1_2_ONLY)} +FUNCTION Supervisor(userFunction : tPROCEDURE location 'a5') : ULONG; syscall _ExecBase 030; +PROCEDURE Alert(alertNum : ULONG location 'd7'); syscall _ExecBase 108; +PROCEDURE Debug(flags : ULONG location 'd0'); syscall _ExecBase 114; +FUNCTION FindResident(const name : pCHAR location 'a1') : pResident; syscall _ExecBase 096; +PROCEDURE InitCode(startClass : ULONG location 'd0'; version : ULONG location 'd1'); syscall _ExecBase 072; +FUNCTION InitResident(const resident_ : pResident location 'a1'; segList : ULONG location 'd0') : POINTER; syscall _ExecBase 102; +PROCEDURE InitStruct(const initTable : POINTER location 'a1'; memory : POINTER location 'a2'; size : ULONG location 'd0'); syscall _ExecBase 078; + +PROCEDURE AddIntServer(intNumber : LONGINT location 'd0'; interrupt_ : pInterrupt location 'a1'); syscall _ExecBase 168; +PROCEDURE Cause(interrupt_ : pInterrupt location 'a1'); syscall _ExecBase 180; +PROCEDURE Disable; syscall _ExecBase 120; +PROCEDURE Enable; syscall _ExecBase 126; +PROCEDURE Forbid; syscall _ExecBase 132; +PROCEDURE Permit; syscall _ExecBase 138; +PROCEDURE RemIntServer(intNumber : LONGINT location 'd0'; interrupt_ : pInterrupt location 'a1'); syscall _ExecBase 174; +FUNCTION SetIntVector(intNumber : LONGINT location 'd0';const interrupt_ : pInterrupt location 'a1') : pInterrupt; syscall _ExecBase 162; +FUNCTION SetSR(newSR : ULONG location 'd0'; mask : ULONG location 'd1') : ULONG; syscall _ExecBase 144; +FUNCTION SuperState : POINTER; syscall _ExecBase 150; +PROCEDURE UserState(sysStack : POINTER location 'd0'); syscall _ExecBase 156; + +FUNCTION AllocAbs(byteSize : ULONG location 'd0'; location : POINTER location 'a1') : POINTER; syscall _ExecBase 204; +FUNCTION Allocate(freeList : pMemHeader location 'a0'; byteSize : ULONG location 'd0') : POINTER; syscall _ExecBase 186; +FUNCTION AllocEntry(entry : pMemList location 'a0') : pMemList; syscall _ExecBase 222; +FUNCTION ExecAllocMem(byteSize : ULONG location 'd0'; requirements : ULONG location 'd1') : POINTER; syscall _ExecBase 198; +FUNCTION AvailMem(requirements : ULONG location 'd1') : ULONG; syscall _ExecBase 216; +PROCEDURE Deallocate(freeList : pMemHeader location 'a0'; memoryBlock : POINTER location 'a1'; byteSize : ULONG location 'd1'); syscall _ExecBase 192; +PROCEDURE FreeEntry(entry : pMemList location 'a0'); syscall _ExecBase 228; +PROCEDURE ExecFreeMem(memoryBlock : POINTER location 'a1'; byteSize : ULONG location 'd0'); syscall _ExecBase 210; + +PROCEDURE AddHead(list : pList location 'a0'; node : pNode location 'a1'); syscall _ExecBase 240; +PROCEDURE AddTail(list : pList location 'a0'; node : pNode location 'a1'); syscall _ExecBase 246; +PROCEDURE Enqueue(list : pList location 'a0'; node : pNode location 'a1'); syscall _ExecBase 270; +FUNCTION FindName(list : pList location 'a0'; const name : pCHAR location 'a1') : pNode; syscall _ExecBase 276; +PROCEDURE ExecInsert(list : pList location 'a0'; node : pNode location 'a1'; pred : pNode location 'a2'); syscall _ExecBase 234; +FUNCTION RemHead(list : pList location 'a0') : pNode; syscall _ExecBase 258; +PROCEDURE Remove(node : pNode location 'a1'); syscall _ExecBase 252; +FUNCTION RemTail(list : pList location 'a0') : pNode; syscall _ExecBase 264; + +FUNCTION AddTask(task : pTask location 'a1';const initPC : POINTER location 'a2';const finalPC : POINTER location 'a3') : POINTER; syscall _ExecBase 282; +FUNCTION AllocSignal(signalNum : LONGINT location 'd0') : shortint; syscall _ExecBase 330; +FUNCTION AllocTrap(trapNum : LONGINT location 'd0') : LONGINT; syscall _ExecBase 342; +FUNCTION FindTask(const name : pCHAR location 'a1') : pTask; syscall _ExecBase 294; +PROCEDURE FreeSignal(signalNum : LONGINT location 'd0'); syscall _ExecBase 336; +PROCEDURE FreeTrap(trapNum : LONGINT location 'd0'); syscall _ExecBase 348; +PROCEDURE RemTask(task : pTask location 'a1'); syscall _ExecBase 288; +FUNCTION SetExcept(newSignals : ULONG location 'd0'; signalSet : ULONG location 'd1') : ULONG; syscall _ExecBase 312; +FUNCTION SetSignal(newSignals : ULONG location 'd0'; signalSet : ULONG location 'd1') : ULONG; syscall _ExecBase 306; +FUNCTION SetTaskPri(task : pTask location 'a1'; priority : LONGINT location 'd0') : shortint; syscall _ExecBase 300; +FUNCTION Wait(signalSet : ULONG location 'd0') : ULONG; syscall _ExecBase 318; + +PROCEDURE AddPort(port : pMsgPort location 'a1'); syscall _ExecBase 354; +FUNCTION FindPort(const name : pCHAR location 'a1') : pMsgPort; syscall _ExecBase 390; +FUNCTION GetMsg(port : pMsgPort location 'a0') : pMessage; syscall _ExecBase 372; +PROCEDURE PutMsg(port : pMsgPort location 'a0'; message : pMessage location 'a1'); syscall _ExecBase 366; +PROCEDURE RemPort(port : pMsgPort location 'a1'); syscall _ExecBase 360; +PROCEDURE ReplyMsg(message : pMessage location 'a1'); syscall _ExecBase 378; +FUNCTION WaitPort(port : pMsgPort location 'a0') : pMessage; syscall _ExecBase 384; + +PROCEDURE AddLibrary(lib : pLibrary location 'a1'); syscall _ExecBase 396; +PROCEDURE CloseLibrary(lib : pLibrary location 'a1'); syscall _ExecBase 414; +PROCEDURE MakeFunctions(const target : POINTER location 'a0';const functionArray : POINTER location 'a1';const funcDispBase :pointer location 'a2'); syscall _ExecBase 090; +FUNCTION MakeLibrary(const funcInit : POINTER location 'a0';const structInit : POINTER location 'a1'; libInit : tPROCEDURE location 'a2';dataSize : ULONG location 'd0'; segList : ULONG location 'd0') : pLibrary; syscall _ExecBase 084; +FUNCTION OldOpenLibrary(const libName : pCHAR location 'a1') : pLibrary; syscall _ExecBase 408; +FUNCTION OpenLibrary(const libName : pCHAR location 'a1'; version : ULONG location 'd0') : pLibrary; syscall _ExecBase 552; +PROCEDURE RemLibrary(lib : pLibrary location 'a1'); syscall _ExecBase 402; +FUNCTION SetFunction(lib : pLibrary location 'a1'; funcOffset : LONGINT location 'a0'; newFunction : tPROCEDURE location 'd0') : POINTER; syscall _ExecBase 420; +PROCEDURE SumLibrary(lib : pLibrary location 'a1'); syscall _ExecBase 426; + +PROCEDURE AbortIO(ioRequest : pIORequest location 'a1'); syscall _ExecBase 480; +PROCEDURE AddDevice(device : pDevice location 'a1'); syscall _ExecBase 432; +FUNCTION CheckIO(ioRequest : pIORequest location 'a1') : pIORequest; syscall _ExecBase 468; +PROCEDURE CloseDevice(ioRequest : pIORequest location 'a1'); syscall _ExecBase 450; +FUNCTION DoIO(ioRequest : pIORequest location 'a1') : shortint; syscall _ExecBase 456; +FUNCTION OpenDevice(const devName : pCHAR location 'a0'; unite : ULONG location 'd0'; ioRequest : pIORequest location 'a1'; flags : ULONG location 'd1') : shortint; syscall _ExecBase 444; +PROCEDURE RemDevice(device : pDevice location 'a1'); syscall _ExecBase 438; +PROCEDURE SendIO(ioRequest : pIORequest location 'a1'); syscall _ExecBase 462; +FUNCTION WaitIO(ioRequest : pIORequest location 'a1') : shortint; syscall _ExecBase 474; + +PROCEDURE AddResource(resource : POINTER location 'a1'); syscall _ExecBase 486; +FUNCTION OpenResource(const resName : pCHAR location 'a1') : POINTER; syscall _ExecBase 498; +PROCEDURE RemResource(resource : POINTER location 'a1'); syscall _ExecBase 492; + +PROCEDURE AddSemaphore(sigSem : pSignalSemaphore location 'a1'); syscall _ExecBase 600; +FUNCTION AttemptSemaphore(sigSem : pSignalSemaphore location 'a0') : LongBool; syscall _ExecBase 576; +FUNCTION FindSemaphore(const sigSem : pCHAR location 'a1') : pSignalSemaphore; syscall _ExecBase 594; +PROCEDURE InitSemaphore(sigSem : pSignalSemaphore location 'a0'); syscall _ExecBase 558; +PROCEDURE ObtainSemaphore(sigSem : pSignalSemaphore location 'a0'); syscall _ExecBase 564; +PROCEDURE ObtainSemaphoreList(sigSem : pList location 'a0'); syscall _ExecBase 582; +FUNCTION Procure(sigSem : pSignalSemaphore location 'a0'; bidMsg : pSemaphoreMessage location 'a1') : LongBool; syscall _ExecBase 540; +PROCEDURE ReleaseSemaphore(sigSem : pSignalSemaphore location 'a0'); syscall _ExecBase 570; +PROCEDURE ReleaseSemaphoreList(sigSem : pList location 'a0'); syscall _ExecBase 588; +PROCEDURE RemSemaphore(sigSem : pSignalSemaphore location 'a1'); syscall _ExecBase 606; +PROCEDURE Vacate(sigSem : pSignalSemaphore location 'a0'; bidMsg : pSemaphoreMessage location 'a1'); syscall _ExecBase 546; + +PROCEDURE AddMemList(size : ULONG location 'd0'; attributes : ULONG location 'd1'; pri : LONGINT location 'd2'; base : POINTER location 'a0'; const name : pCHAR location 'a1'); syscall _ExecBase 618; +PROCEDURE CopyMem(const source : POINTER location 'a0'; dest : POINTER location 'a1'; size : ULONG location 'd0'); syscall _ExecBase 624; +PROCEDURE CopyMemQuick(const source : POINTER location 'a0'; dest : POINTER location 'a1'; size : ULONG location 'd0'); syscall _ExecBase 630; +PROCEDURE SumKickData; syscall _ExecBase 612; + +FUNCTION GetCC : ULONG; syscall _ExecBase 528; +function RawDoFmt(const formatString : pCHAR location 'a0';const dataStream : POINTER location 'a1'; putChProc : tPROCEDURE location 'a2'; putChData : POINTER location 'a3'): pointer; syscall _ExecBase 522; +FUNCTION TypeOfMem(const address : POINTER location 'a1') : ULONG; syscall _ExecBase 534; + +{$else} PROCEDURE AbortIO(ioRequest : pIORequest location 'a1'); syscall _ExecBase 480; PROCEDURE AddDevice(device : pDevice location 'a1'); syscall _ExecBase 432; PROCEDURE AddHead(list : pList location 'a0'; node : pNode location 'a1'); syscall _ExecBase 240; @@ -1306,6 +1411,7 @@ FUNCTION AVL_FindNextNodeByAddress(CONST node : pAVLNode location 'a0') : pAVLNo FUNCTION AVL_FindNextNodeByKey(CONST root : pAVLNode location 'a0'; key : POINTER location 'a1'; func : POINTER location 'a2') : pAVLNode; syscall _ExecBase 894; FUNCTION AVL_FindFirstNode(CONST root : pAVLNode location 'a0') : pAVLNode; syscall _ExecBase 900; FUNCTION AVL_FindLastNode(CONST root : pAVLNode location 'a0') : pAVLNode; syscall _ExecBase 906; +{$endif} FUNCTION FindName(list : pList; const name : String) : pNode; FUNCTION FindPort(const name : String) : pMsgPort; @@ -1333,6 +1439,16 @@ function CreateTask(Name: STRPTR; Pri: LongInt; InitPC: Pointer; StackSize: Long procedure DeleteTask(Task: PTask); procedure NewList(List: PList); +{$if defined(AMIGA_V1_2_ONLY)} +function CreateMsgPort: PMsgPort; +procedure DeleteMsgPort(Port: PMsgPort); + +function CreateIORequest(const Port: PMsgPort; Size: LongWord): PIORequest; +procedure DeleteIORequest(IOReq: PIORequest); +{$endif} + + + IMPLEMENTATION function BitMask(no :shortint): longint; inline; @@ -1444,6 +1560,17 @@ begin end end; +{$if defined(AMIGA_V1_2_ONLY)} +function CreateIORequest(const Port: PMsgPort; Size: LongWord): PIORequest; +begin + CreateIORequest := CreateExtIO(Port, Size); +end; + +procedure DeleteIORequest(IOReq: PIORequest); +begin + DeleteExtIO(IOReq); +end; +{$endif} function CreateStdIO(Port: PMsgPort): PIOStdReq; begin @@ -1507,6 +1634,18 @@ begin end; end; +{$if defined(AMIGA_V1_2_ONLY)} +function CreateMsgPort: PMsgPort; +begin + CreateMsgPort := CreatePort(nil, 0); +end; + +procedure DeleteMsgPort(Port: PMsgPort); +begin + DeletePort(Port); +end; +{$endif} + function CreateTask(Name: STRPTR; Pri: LongInt; InitPC: Pointer; StackSize: LongWord): PTask; var Memlist: PMemList; diff --git a/packages/amunits/src/coreunits/intuition.pas b/packages/amunits/src/coreunits/intuition.pas index fed7dc02f9..adf1bca472 100644 --- a/packages/amunits/src/coreunits/intuition.pas +++ b/packages/amunits/src/coreunits/intuition.pas @@ -4067,6 +4067,94 @@ CONST var IntuitionBase: pIntuitionBase; +{$if defined(AMIGA_V1_2_ONLY)} +PROCEDURE ActivateWindow(window : pWindow location 'a0'); syscall _IntuitionBase 450; +PROCEDURE CloseWindow(window : pWindow location 'a0'); syscall _IntuitionBase 072; +FUNCTION ModifyIDCMP(window : pWindow location 'a0'; flags : ULONG location 'd0') : LongBool; syscall _IntuitionBase 150; +PROCEDURE MoveWindow(window : pWindow location 'a0'; dx : LONGINT location 'd0'; dy : LONGINT location 'd1'); syscall _IntuitionBase 168; +FUNCTION OpenWindow(const newWindow : pNewWindow location 'a0') : pWindow; syscall _IntuitionBase 204; +PROCEDURE RefreshWindowFrame(window : pWindow location 'a0'); syscall _IntuitionBase 456; +PROCEDURE SetWindowTitles(window : pWindow location 'a0';const windowTitle : pCHAR location 'a1';const screenTitle : pCHAR location 'a2'); syscall _IntuitionBase 276; +PROCEDURE SizeWindow(window : pWindow location 'a0'; dx : LONGINT location 'd0'; dy : LONGINT location 'd1'); syscall _IntuitionBase 288; +FUNCTION WindowLimits(window : pWindow location 'a0'; widthMin : LONGINT location 'd0'; heightMin : LONGINT location 'd1'; widthMax : ULONG location 'd2'; heightMax : ULONG location 'd3') : LongBool; syscall _IntuitionBase 318; +PROCEDURE WindowToBack(window : pWindow location 'a0'); syscall _IntuitionBase 306; +PROCEDURE WindowToFront(window : pWindow location 'a0'); syscall _IntuitionBase 312; + +FUNCTION ActivateGadget(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2') : LongBool syscall _IntuitionBase 462; +FUNCTION AddGadget(window : pWindow location 'a0'; gadget : pGadget location 'a1'; position : ULONG location 'd0') : WORD; syscall _IntuitionBase 042; +FUNCTION AddGList(window : pWindow location 'a0'; gadget : pGadget location 'a1'; position : ULONG location 'd0'; numGad : LONGINT location 'd1'; requester : pRequester location 'a2') : WORD; syscall _IntuitionBase 438; +PROCEDURE ModifyProp(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; flags : ULONG location 'd0'; horizPot : ULONG location 'd1'; vertPot : ULONG location 'd2'; horizBody : ULONG location 'd3'; vertBody : ULONG location 'd4'); syscall _IntuitionBase 156; +PROCEDURE NewModifyProp(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; flags : ULONG location 'd0'; horizPot : ULONG location 'd1'; vertPot : ULONG location 'd2'; horizBody : ULONG location 'd3'; vertBody : ULONG location 'd4'; numGad : LONGINT location 'd5'); syscall _IntuitionBase 468; +PROCEDURE OffGadget(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'); syscall _IntuitionBase 174; +PROCEDURE OnGadget(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'); syscall _IntuitionBase 186; +PROCEDURE RefreshGadgets(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'); syscall _IntuitionBase 222; +PROCEDURE RefreshGList(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; numGad : LONGINT location 'd0'); syscall _IntuitionBase 432; +FUNCTION RemoveGadget(window : pWindow; gadget : pGadget) : WORD; syscall _IntuitionBase 228; +FUNCTION RemoveGList(remPtr : pWindow location 'a0'; gadget : pGadget location 'a1'; numGad : LONGINT location 'd0') : WORD; syscall _IntuitionBase 444; + +PROCEDURE ClearMenuStrip(window : pWindow location 'a0'); syscall _IntuitionBase 054; +FUNCTION ItemAddress(const menuStrip : pMenu location 'a0'; menuNumber : ULONG location 'd0') : pMenuItem; syscall _IntuitionBase 144; +PROCEDURE OffMenu(window : pWindow location 'a0'; menuNumber : ULONG location 'd0'); syscall _IntuitionBase 180; +PROCEDURE OnMenu(window : pWindow location 'a0'; menuNumber : ULONG location 'd0'); syscall _IntuitionBase 192; +FUNCTION SetMenuStrip(window : pWindow location 'a0'; menu : pMenu location 'a1') : LongBool; syscall _IntuitionBase 264; + +FUNCTION AutoRequest(window : pWindow location 'a0';const body : pIntuiText location 'a1';const posText : pIntuiText location 'a2';const negText : pIntuiText location 'a3'; pFlag : ULONG location 'd0'; nFlag : ULONG location 'd1'; width : ULONG location 'd2'; height : ULONG location 'd3') : LongBool; syscall _IntuitionBase 348; +FUNCTION BuildSysRequest(window : pWindow location 'a0';const body : pIntuiText location 'a1';const posText : pIntuiText location 'a2';const negText : pIntuiText location 'a3'; flags : ULONG location 'd0'; width : ULONG location 'd1'; height : ULONG location 'd2') : pWindow; syscall _IntuitionBase 360; +FUNCTION ClearDMRequest(window : pWindow location 'a0') : LongBool; syscall _IntuitionBase 048; +FUNCTION DisplayAlert(alertNumber : ULONG location 'd0';const string_ : pCHAR location 'a0'; height : ULONG location 'd1') : LongBool; syscall _IntuitionBase 090; +PROCEDURE EndRequest(requester : pRequester location 'a0'; window : pWindow location 'a1'); syscall _IntuitionBase 120; +PROCEDURE FreeSysRequest(window : pWindow location 'a0'); syscall _IntuitionBase 372; +PROCEDURE InitRequester(requester : pRequester location 'a0'); syscall _IntuitionBase 138; +FUNCTION Request(requester : pRequester location 'a0'; window : pWindow location 'a1') : LongBool; syscall _IntuitionBase 240; +FUNCTION SetDMRequest(window : pWindow location 'a0'; requester : pRequester location 'a1') : LongBool; syscall _IntuitionBase 258; + +function CloseScreen(screen : pScreen location 'a0'): LongBool; syscall _IntuitionBase 066; +FUNCTION CloseWorkBench : LongBool; syscall _IntuitionBase 078; +PROCEDURE DisplayBeep(screen : pScreen location 'a0'); syscall _IntuitionBase 096; +FUNCTION GetScreenData(buffer : POINTER location 'a0'; size : ULONG location 'D0'; type_ : ULONG location 'd1';const screen : pScreen location 'a1') : LongBool; syscall _IntuitionBase 426; +FUNCTION MakeScreen(screen : pScreen location 'a0') : LONGINT; syscall _IntuitionBase 378; +PROCEDURE MoveScreen(screen : pScreen location 'a0'; dx : LONGINT location 'd0'; dy : LONGINT location 'd1'); syscall _IntuitionBase 162; +FUNCTION OpenScreen(const newScreen : pNewScreen location 'a0') : pScreen; syscall _IntuitionBase 198; +FUNCTION OpenWorkBench : ULONG; syscall _IntuitionBase 210; +PROCEDURE ScreenToBack(screen : pScreen location 'a0'); syscall _IntuitionBase 246; +PROCEDURE ScreenToFront(screen : pScreen location 'a0'); syscall _IntuitionBase 252; +PROCEDURE ShowTitle(screen : pScreen location 'a0'; showIt : LONGINT location 'd0'); syscall _IntuitionBase 282; +FUNCTION WBenchToBack : LongBool; syscall _IntuitionBase 336; +FUNCTION WBenchToFront : LongBool; syscall _IntuitionBase 342; + +PROCEDURE ClearPointer(window : pWindow location 'a0'); syscall _IntuitionBase 060; +PROCEDURE DrawBorder(rp : pRastPort location 'a0';const border : pBorder location 'a1'; leftOffset : LONGINT location 'd0'; topOffset : LONGINT location 'd1'); syscall _IntuitionBase 108; +PROCEDURE DrawImage(rp : pRastPort location 'a0'; image : pImage location 'a1'; leftOffset : LONGINT location 'd0'; topOffset : LONGINT location 'd1'); syscall _IntuitionBase 114; +FUNCTION IntuiTextLength(const iText : pIntuiText location 'a0') : LONGINT; syscall _IntuitionBase 330; +PROCEDURE PrintIText(rp : pRastPort location 'a0';const iText : pIntuiText location 'a1'; left : LONGINT location 'd0'; top : LONGINT location 'd1'); syscall _IntuitionBase 216; +PROCEDURE SetPointer(window : pWindow location 'a0'; pointer_ : pword location 'a1'; height : LONGINT location 'd0'; width : LONGINT location 'd1'; xOffset : LONGINT location 'd2'; yOffset : LONGINT location 'd3'); syscall _IntuitionBase 270; + +FUNCTION AllocRemember(var rememberKey : pRemember location 'a0'; size : ULONG location 'd0'; flags : ULONG location 'd1') : POINTER syscall _IntuitionBase 396; +PROCEDURE FreeRemember(VAR rememberKey : pRemember location 'a0'; reallyForget : LONGINT location 'd0'); syscall _IntuitionBase 408; + +PROCEDURE BeginRefresh(window : pWindow location 'a0'); syscall _IntuitionBase 354; +PROCEDURE EndRefresh(window : pWindow location 'a0'; complete : LONGBOOL location 'd0'); syscall _IntuitionBase 366; +FUNCTION RemakeDisplay : LONGINT; syscall _IntuitionBase 384; +FUNCTION RethinkDisplay : LONGINT; syscall _IntuitionBase 390; + +FUNCTION LockIBase(dontknow : ULONG location 'd0') : ULONG; syscall _IntuitionBase 414; +PROCEDURE UnlockIBase(ibLock : ULONG location 'a0'); syscall _IntuitionBase 420; +FUNCTION ViewAddress : pView; syscall _IntuitionBase 294; +FUNCTION ViewPortAddress(const window : pWindow location 'a0') : pViewPort; syscall _IntuitionBase 300; + +PROCEDURE CurrentTime(VAR seconds : ULONG location 'a0'; VAR micros : ULONG location 'a1'); syscall _IntuitionBase 084; +FUNCTION DoubleClick(sSeconds : ULONG location 'd0'; sMicros : ULONG location 'd1'; cSeconds : ULONG location 'd2'; cMicros : ULONG location 'd3') : LongBool; syscall _IntuitionBase 102; +FUNCTION GetDefPrefs(preferences : pPreferences location 'a0'; size : LONGINT location 'd0') : pPreferences; syscall _IntuitionBase 126; +FUNCTION GetPrefs(preferences : pPreferences location 'a0'; size : LONGINT location 'd0') : pPreferences; syscall _IntuitionBase 132; +PROCEDURE ReportMouse(flag : LONGINT location 'd0'; window : pWindow location 'a0'); syscall _IntuitionBase 234; +FUNCTION SetPrefs(const preferences : pPreferences location 'a0'; size : LONGINT location 'd0'; inform : LONGINT location 'd1') : pPreferences; syscall _IntuitionBase 324; + +function OpenWindowTagList(NewWindow: PNewWindow; TagList: PTagItem):PWindow; +function OpenScreenTagList(NewScreen: PNewScreen; TagList: PTagItem): PScreen; +function EasyRequestArgs(Window: PWindow; const EasyStruct: PEasyStruct; IDCMPPtr: PLongWord; const Args: Pointer): LongInt; + + +{$else} FUNCTION ActivateGadget(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2') : LongBool syscall _IntuitionBase 462; PROCEDURE ActivateWindow(window : pWindow location 'a0'); syscall _IntuitionBase 450; PROCEDURE AddClass(classPtr : pIClass location 'a0'); syscall _IntuitionBase 684; @@ -4189,24 +4277,29 @@ FUNCTION WindowLimits(window : pWindow location 'a0'; widthMin : LONGINT locatio PROCEDURE WindowToBack(window : pWindow location 'a0'); syscall _IntuitionBase 306; PROCEDURE WindowToFront(window : pWindow location 'a0'); syscall _IntuitionBase 312; PROCEDURE ZipWindow(window : pWindow location 'a0'); syscall _IntuitionBase 504; +{$endif} function OpenScreenTags(newScreen : pNewScreen; tagList : array of PtrUInt) : pScreen; function OpenWindowTags(newWindow : pNewWindow; tagList : array of PtrUInt) : pWindow; + +{$if not defined(AMIGA_V1_2_ONLY)} +function NewObject(classPtr : pIClass; classID : string; Const argv : array of PtrUInt ) : POINTER; function NewObject(classPtr : pIClass; classID : pCHAR; Const argv : array of PtrUInt) : POINTER; function SetAttrs(obj : POINTER; tags: array of DWord) : ULONG; function SetGadgetAttrs(gadget : pGadget; window : pWindow; requester : pRequester; Const argv : array of PtrUInt) : ULONG; -function NewObject(classPtr : pIClass; classID : string; Const argv : array of PtrUInt ) : POINTER; -function EasyRequest(window : pWindow;const easyStruct : pEasyStruct; idcmpPtr : pULONG; args : array of DWord) : LONGINT; procedure SetWindowPointer(win : pWindow; tags: array of DWord); - +{$endif} +function EasyRequest(window : pWindow;const easyStruct : pEasyStruct; idcmpPtr : pULONG; args : array of DWord) : LONGINT; { Intuition macros } +{$if not defined(AMIGA_V1_2_ONLY)} function INST_DATA (cl: pIClass; o: p_Object): Pointer; function SIZEOF_INSTANCE (cl: pIClass): Longint; function BASEOBJECT (o: p_Object): Pointer; function _OBJ(o: p_Object): p_Object; inline; function __OBJECT (o: Pointer): p_Object; inline; function OCLASS (o: Pointer): pIClass; inline; +{$endif} function SHIFTITEM (n: smallint): word; function SHIFTMENU (n: smallint): word; function SHIFTSUB (n: smallint): word; @@ -4222,14 +4315,17 @@ function SUBNUM( n : Word): Word; FUNCTION DisplayAlert(alertNumber : ULONG;const string_ : string; height : ULONG) : BOOLEAN; FUNCTION LockPubScreen(const name : string) : pScreen; +{$if not defined(AMIGA_V1_2_ONLY)} FUNCTION MakeClass(const classID : string;const superClassID : pCHAR;const superClassPtr : pIClass; instanceSize : ULONG; flags : ULONG) : pIClass; FUNCTION MakeClass(const classID : pCHAR;const superClassID : string;const superClassPtr : pIClass; instanceSize : ULONG; flags : ULONG) : pIClass; FUNCTION MakeClass(const classID : string;const superClassID : string;const superClassPtr : pIClass; instanceSize : ULONG; flags : ULONG) : pIClass; FUNCTION NewObjectA(classPtr : pIClass;const classID : string;const tagList : pTagItem) : POINTER; +{$endif} PROCEDURE SetDefaultPubScreen(const name : string); FUNCTION TimedDisplayAlert(alertNumber : ULONG;const string_ : string; height : ULONG; time : ULONG) : BOOLEAN; PROCEDURE UnlockPubScreen(const name : string; screen : pScreen); +{$if not defined(AMIGA_V1_2_ONLY)} function DoMethodA(Obj: PObject_; Msg: APTR): PtrUInt; function DoSuperMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt; function CoerceMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt; @@ -4237,9 +4333,265 @@ function SetSuperAttrsA(Cl: PIClass; Obj: PObject_; Msg : APTR): PtrUInt; function DoMethod(Obj: PObject_; Params: array of PtrUInt): LongWord; inline; function DoSuperMethod(Cl: PIClass; Obj: PObject_; const Params: array of PtrUInt): PtrUInt; inline; +{$endif} IMPLEMENTATION + +{$if defined(AMIGA_V1_2_ONLY)} +function OpenWindowTagList(NewWindow: PNewWindow; TagList: PTagItem):PWindow; +var + Nw: TNewWindow; + Scr: PScreen; + LockedScreenName: PChar; + ScreenTitle: PChar; + Win: PWindow; + ILock: LongWord; +begin + if not Assigned(NewWindow) then + begin + NewWindow := @Nw; + FillChar(Nw, SizeOf(Nw), 0); + NW.LeftEdge := 20; + NW.TopEdge := 20; + NW.Width := 200; + NW.Height := 100; + Nw.DetailPen := 0; + Nw.BlockPen := 1; + nw.MaxWidth := 640; + nw.MaxHeight := 512; + nw.WType := WBENCHSCREEN_F; + end; + LockedScreenName := nil; + ScreenTitle := nil; + // + while TagList <> nil do + begin + case TagList^.ti_Tag of + WA_Flags: NewWindow^.Flags := NewWindow^.Flags or TagList^.ti_Data; + WA_Gadgets: NewWindow^.FirstGadget := Pointer(TagList^.ti_Data); + WA_GimmeZeroZero: NewWindow^.Flags := NewWindow^.Flags or WFLG_GIMMEZEROZERO; + WA_InnerHeight,WA_Height: NewWindow^.Height := TagList^.ti_Data; + WA_IDCMP: NewWindow^.IDCMPFlags := NewWindow^.IDCMPFlags or TagList^.ti_Data; + WA_Left: NewWindow^.LeftEdge := TagList^.ti_Data; + WA_MaxHeight: NewWindow^.MaxHeight := TagList^.ti_Data; + WA_MaxWidth: NewWindow^.MaxWidth := TagList^.ti_Data; + WA_MinHeight: NewWindow^.MinHeight := TagList^.ti_Data; + WA_MinWidth: NewWindow^.MinWidth := TagList^.ti_Data; + WA_NoCareRefresh: NewWindow^.Flags := NewWindow^.Flags or WFLG_NOCAREREFRESH; + WA_PubScreen: NewWindow^.Screen := Pointer(TagList^.ti_Data); + WA_PubScreenName: + begin + ILock := LockIBase(0); + LockedScreenName := PChar(TagList^.ti_Data); + if (LowerCase(string(LockedScreenName)) = 'workbench') or (LockedScreenName = nil) then + begin + NewWindow^.WType := WBENCHSCREEN_F; + NewWindow^.Screen := nil; + end + else + begin + Scr := pIntuitionBase(_IntuitionBase)^.FirstScreen; + while Assigned(Scr) do + begin + if LowerCase(string(scr^.Title)) = LowerCase(string(LockedScreenName)) then + begin + NewWindow^.Screen := Scr; + NewWindow^.WType := CUSTOMSCREEN_F; + Break; + end; + Scr := Scr^.NextScreen + end; + UnlockIBase(ILock); + end; + end; + WA_ReportMouse: NewWindow^.Flags := NewWindow^.Flags or WFLG_REPORTMOUSE; + WA_RMBTrap: NewWindow^.Flags := NewWindow^.Flags or WFLG_RMBTRAP; + WA_ScreenTitle: ScreenTitle := PChar(TagList^.ti_Data); + WA_SimpleRefresh: NewWindow^.Flags := NewWindow^.Flags or WFLG_SIMPLE_REFRESH; + WA_SizeBBottom: NewWindow^.Flags := NewWindow^.Flags or WFLG_SIZEBBOTTOM; + WA_SizeBRight: NewWindow^.Flags := NewWindow^.Flags or WFLG_SIZEBRIGHT; + WA_SizeGadget: NewWindow^.Flags := NewWindow^.Flags or WFLG_SIZEGADGET; + WA_SmartRefresh: NewWindow^.Flags := NewWindow^.Flags or WFLG_SMART_REFRESH; + WA_SuperBitMap: NewWindow^.BitMap := Pointer(TagList^.ti_Data); + WA_Title: NewWindow^.Title := PChar(TagList^.ti_Data); + WA_Top: NewWindow^.TopEdge := TagList^.ti_Data; + WA_InnerWidth,WA_Width: NewWindow^.Width := TagList^.ti_Data; + end; + TagList := NextTagItem(TagList); + end; + Win := OpenWindow(NewWindow); + if Assigned(Win) and Assigned(ScreenTitle) then + SetWindowTitles(Win, NewWindow^.Title, ScreenTitle); + OpenWindowTagList := Win; +end; + +function OpenScreenTagList(NewScreen: PNewScreen; TagList: PTagItem): PScreen; +var + Scr: PScreen; + Ns: TNewScreen; + ILock: LongWord; + STagList: PTagItem; +begin + OpenScreenTagList := nil; + if not Assigned(NewScreen) then + begin + NewScreen := @Ns; + FillChar(Ns, SizeOf(Ns), 0); + Ns.LeftEdge := 0; + Ns.TopEdge := 0; + Ns.Width := 320; + Ns.Height := 200; + Ns.DetailPen := 0; + Ns.BlockPen := 1; + Ns.Depth := 1; + Ns.ViewModes := 0; + end; + // SEarch for Like Workbench + STagList := TagList; + while STagList <> nil do + begin + if STagList^.ti_Tag = SA_LikeWorkbench then + begin + ILock := LockIBase(0); + Scr := PIntuitionBase(_IntuitionBase)^.FirstScreen; + if Assigned(Scr) then + begin + NewScreen^.LeftEdge := Scr^.LeftEdge; + NewScreen^.TopEdge := Scr^.TopEdge; + NewScreen^.Width := Scr^.Width; + NewScreen^.Height := Scr^.Height; + NewScreen^.Font := Scr^.Font; + NewScreen^.Depth := Scr^.BitMap.Depth; + NewScreen^.DetailPen := Scr^.DetailPen; + NewScreen^.BlockPen := Scr^.BlockPen; + NewScreen^.ViewModes := Scr^.ViewPort.Modes; + NewScreen^.SType := Scr^.Flags; // not sure if that is correct + end; + UnlockIBase(ILock); + end; + STagList := NextTagItem(STagList); + end; + // check the other tags + while TagList <> nil do + begin + case TagList^.ti_Tag of + SA_AutoScroll: if TagList^.ti_Data <> 0 then NewScreen^.SType := NewScreen^.SType or AUTOSCROLL else NewScreen^.SType := NewScreen^.SType and not AUTOSCROLL; + SA_Behind: if TagList^.ti_Data <> 0 then NewScreen^.SType := NewScreen^.SType or SCREENBEHIND_F else NewScreen^.SType := NewScreen^.SType and not SCREENBEHIND_F; + SA_BitMap: begin NewScreen^.SType := NewScreen^.SType or CUSTOMBITMAP_F; NewScreen^.CustomBitMap := Pointer(TagList^.ti_Data); end; + SA_BlockPen: NewScreen^.BlockPen := TagList^.ti_Data; + //SA_ColorMapEntries: TODO: + //SA_Colors: todo: after + //SA_Colors32: todo: after + SA_Depth: NewScreen^.Depth := TagList^.ti_Data; + SA_DetailPen: NewScreen^.DetailPen := TagList^.ti_Data; + SA_Font: NewScreen^.Font := Pointer(TagList^.ti_Data); + //SA_FullPalette: TODO: + //SA_Pens: TODO: + SA_Height: NewScreen^.Height := TagList^.ti_Data; + SA_Left: NewScreen^.LeftEdge := TagList^.ti_Data; + //SA_PubName: TODO: hmmm, not really possible + SA_Quiet: if TagList^.ti_Data <> 0 then NewScreen^.SType := NewScreen^.SType or SCREENQUIET_F else NewScreen^.SType := NewScreen^.SType and not SCREENQUIET_F; + SA_ShowTitle: if TagList^.ti_Data <> 0 then NewScreen^.SType := NewScreen^.SType or SHOWTITLE_F else NewScreen^.SType := NewScreen^.SType and not SHOWTITLE_F; + SA_Title: NewScreen^.DefaultTitle := PChar(TagList^.ti_Data); + SA_Top: NewScreen^.TopEdge := TagList^.ti_Data; + SA_Type: NewScreen^.SType := NewScreen^.SType or (TagList^.ti_Data) and not PUBLICSCREEN_F; + SA_DisplayID: NewScreen^.ViewModes := TagList^.ti_Data; + SA_Width: NewScreen^.Width := TagList^.ti_Data; + end; + TagList := NextTagItem(TagList); + end; + Scr := OpenScreen(NewScreen); + OpenScreenTagList := Scr; +end; + +function EasyRequestArgs(Window: PWindow; const EasyStruct: PEasyStruct; IDCMPPtr: PLongWord; const Args: Pointer): LongInt; +var + Body, PosText, NegText: TIntuiText; + pFlags, nFlags, Width, Height: LongWord; + pText, NText, s: AnsiString; + Found: Boolean; + i: Integer; + Target: array[0..255] of Char; + Magic: LongWord; +begin + Magic := $16c04e75; // move.b d0,(a3)+ rts + RawDoFmt(easyStruct^.es_TextFormat, args, TProcedure(@Magic), @Target[0]); + with Body do + begin + BackPen := 1; + FrontPen := 2; + DrawMode := JAM1; + IText := @Target[0]; + LeftEdge := 17; + TopEdge := 20; + ITextFont := nil; + NextText := nil; + end; + // + NText := ''; + PText := ''; + if Assigned(easyStruct^.es_GadgetFormat) then + begin + s := string(easyStruct^.es_GadgetFormat); + Found := False; + for i := 1 to Length(s) do + begin + if not Found and (s[i] = '|') then + Found := True + else + begin + if Found then + NText := NText + s[i] + else + PText := PText + s[i]; + end; + end; + end; + + if (PText = '') and (NText = '') then + PText := 'Ok'; + + with PosText do + begin + BackPen := 1; + FrontPen := 2; + DrawMode := JAM1; + IText := PChar(PText); + LeftEdge := 7; + TopEdge := 4; + ITextFont := nil; + NextText := nil; + end; + + with NegText do + begin + BackPen := 1; + FrontPen := 2; + DrawMode := JAM1; + IText := PChar(NText); + LeftEdge := 7; + TopEdge := 4; + ITextFont := nil; + NextText := nil; + end; + + Width := IntuiTextLength(@Body) + 50; + Height := 70; + if idcmpPtr <> nil then + pFlags := idcmpPtr^ + else + pFlags := 0; + NFlags := 0; + + if AutoRequest(Window, @Body, @PosText, @NegText, pFlags, nFlags, Width, Height) then + EasyRequestArgs := 1 + else + EasyRequestArgs := 0; +end; +{$endif} + + function OpenScreenTags(newScreen : pNewScreen; tagList : array of PtrUInt) : pScreen; begin OpenScreenTags := OpenScreenTagList(newScreen, @tagList); @@ -4250,6 +4602,7 @@ begin OpenWindowTags := OpenWindowTagList(newWindow, @tagList); end; +{$if not defined(AMIGA_V1_2_ONLY)} function NewObject(classPtr : pIClass; classID : pCHAR; Const argv : array of PtrUInt) : POINTER; begin NewObject := NewObjectA(classPtr,classID, @argv); @@ -4270,16 +4623,19 @@ begin SetGadgetAttrs := SetGadgetAttrsA(gadget,window,requester,@argv); end; +procedure SetWindowPointer(win : pWindow; tags: array of DWord); +begin + SetWindowPointerA(win, @tags); +end; +{$endif} + function EasyRequest(window : pWindow;const easyStruct : pEasyStruct; idcmpPtr : pULONG; args : array of DWord) : LONGINT; begin EasyRequest := EasyRequestArgs(window, easystruct, idcmpptr, @args); end; -procedure SetWindowPointer(win : pWindow; tags: array of DWord); -begin - SetWindowPointerA(win, @tags); -end; +{$if not defined(AMIGA_V1_2_ONLY)} function INST_DATA (cl: pIClass; o: p_Object): Pointer; inline; begin INST_DATA := Pointer(Longint(o) + cl^.cl_InstOffset); @@ -4309,6 +4665,7 @@ function OCLASS (o: Pointer): pIClass; inline; begin OCLASS := p_Object(o - sizeof(t_Object))^.o_Class; end; +{$endif} function SHIFTITEM (n: smallint): word; inline; begin @@ -4389,6 +4746,7 @@ begin LockPubScreen := LockPubScreen(PChar(RawByteString(name))); end; +{$if not defined(AMIGA_V1_2_ONLY)} FUNCTION MakeClass(const classID : string;const superClassID : pCHAR;const superClassPtr : pIClass; instanceSize : ULONG; flags : ULONG) : pIClass; begin MakeClass := MakeClass(PChar(RawByteString(classID)),superClassID,superClassPtr,instanceSize,flags); @@ -4408,6 +4766,7 @@ FUNCTION NewObjectA(classPtr : pIClass;const classID : string;const tagList : pT begin NewObjectA := NewObjectA(classPtr,PChar(RawByteString(classID)),taglist); end; +{$endif} PROCEDURE SetDefaultPubScreen(const name : string); begin @@ -4424,7 +4783,7 @@ begin UnlockPubScreen(PChar(RawByteString(name)),screen); end; - +{$if not defined(AMIGA_V1_2_ONLY)} function DoMethodA(Obj: PObject_; Msg: APTR): PtrUInt; begin if Assigned(Obj) then @@ -4470,6 +4829,7 @@ begin arr[2] := 0; SetSuperAttrsA := DoSuperMethodA(Cl, Obj, @arr); end; +{$endif} initialization IntuitionBase := pIntuitionBase(_IntuitionBase); diff --git a/packages/amunits/src/coreunits/keymap.pas b/packages/amunits/src/coreunits/keymap.pas index 436e84c100..e58bc3aa8d 100644 --- a/packages/amunits/src/coreunits/keymap.pas +++ b/packages/amunits/src/coreunits/keymap.pas @@ -110,13 +110,58 @@ VAR KeymapBase : pLibrary = nil; const KEYMAPNAME : PChar = 'keymap.library'; +{$if defined(AMIGA_V1_2_ONLY)} +function MapRawKey(event: PInputEvent; Buffer: PCHAR; Length: LongInt; keyMap: PKeyMap): SmallInt; +{$else} FUNCTION AskKeyMapDefault : pKeyMap; syscall KeymapBase 036; FUNCTION MapANSI(thestring : pCHAR location 'a0'; count : LONGINT location 'd0'; buffer : pCHAR location 'a1'; length : LONGINT location 'd1'; keyMap : pKeyMap location 'a2') : LONGINT; syscall KeymapBase 048; FUNCTION MapRawKey(event : pInputEvent location 'a0'; buffer : pCHAR location 'a1'; length : LONGINT location 'd1'; keyMap : pKeyMap location 'a2') : smallint; syscall KeymapBase 042; PROCEDURE SetKeyMapDefault(keyMap : pKeyMap location 'a0'); syscall KeymapBase 030; +{$endif} IMPLEMENTATION +{$if defined(AMIGA_V1_2_ONLY)} +var + ConDev: PDevice = nil; + ConMsgPort: PMsgPort = nil; + ConIOReq: PIORequest = nil; + +function RawKeyConvert(Events: PInputEvent location 'a0'; Buffer: PCHAR location 'a1'; Length: LongInt location 'd1'; KeyMap: PKeyMap location 'a2'): LongInt; syscall ConDev 048; + +function MapRawKey(event: PInputEvent; Buffer: PCHAR; Length: LongInt; keyMap: PKeyMap): SmallInt; +begin + if not Assigned(ConDev) then + begin + ConMsgPort := CreatePort(nil, 0); + ConIOReq := CreateExtIO(ConMsgPort, SizeOf(TIOStdReq)); + + OpenDevice('console.device', -1, ConIOReq, 0); + + ConDev := ConIOReq^.io_Device; + end; + if Assigned(ConDev) then + MapRawKey := RawKeyConvert(event, Buffer, length, keymap) + else + MapRawKey := 0; +end; + +procedure CloseKeyMapConsole; +begin + if Assigned(ConDev) and Assigned(ConIOReq) then + begin + CloseDevice(ConIOReq); + DeleteExtIO(ConIOReq); + end; + ConDev := nil; + ConIOReq := nil; + if Assigned(ConMsgPort) then + DeletePort(ConMsgPort); + ConMsgPort := nil; +end; + +{$endif} + const { Change VERSION and LIBVERSION to proper values } VERSION : string[2] = '0'; @@ -127,6 +172,9 @@ initialization finalization if Assigned(KeymapBase) then CloseLibrary(KeymapBase); + {$if defined(AMIGA_V1_2_ONLY)} + CloseKeyMapConsole; + {$endif} END. (* UNIT KEYMAP *) diff --git a/packages/amunits/src/coreunits/utility.pas b/packages/amunits/src/coreunits/utility.pas index a2e96ed2ee..92520af432 100644 --- a/packages/amunits/src/coreunits/utility.pas +++ b/packages/amunits/src/coreunits/utility.pas @@ -339,6 +339,11 @@ Type var UtilityBase: pUtilityBase; +{$if defined(AMIGA_V1_2_ONLY)} +function NextTagItem(var Item: PTagItem): PTagItem; inline; + +{$else} + function AddNamedObject(nameSpace : pNamedObject location 'a0';obj : pNamedObject location 'a1') : LongBool; syscall _UtilityBase 222; function AllocateTagItems(num : ULONG location 'd0') : pTagItem; syscall _UtilityBase 066; function AllocNamedObjectA(const name : STRPTR location 'a0';const TagList : pTagItem location 'a1') : pNamedObject; syscall _UtilityBase 228; @@ -389,6 +394,7 @@ FUNCTION Stricmp(CONST string1 : string; CONST string2 : string) : LONGINT; FUNCTION Strnicmp(CONST string1 : string; CONST string2 : pCHAR; length : LONGINT) : LONGINT; FUNCTION Strnicmp(CONST string1 : pCHAR; CONST string2 : string; length : LONGINT) : LONGINT; FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGINT) : LONGINT; +{$endif} function TAG_(value: pointer): PtrUInt; overload; inline; @@ -408,6 +414,40 @@ procedure HookEntryPas; IMPLEMENTATION +{$if defined(AMIGA_V1_2_ONLY)} +{$HINTS OFF} + +function NextTagItem(var Item: PTagItem): PTagItem; inline; +begin + NextTagItem := nil; + if Item = nil then + Exit; + // + Inc(Item); + repeat + if Item = nil then + Exit; + case Item^.ti_Tag of + TAG_DONE: + begin + Item := nil; + NextTagItem := nil; + Exit; + end; + TAG_SKIP: Inc(Item, Item^.ti_Data); + TAG_MORE: Item := PTagItem(Item^.ti_Data); + TAG_IGNORE: Inc(Item); + else + begin + NextTagItem := Item; + Exit; + end; + end; + until False; +end; +{$else} + + function AllocNamedObject(name : STRPTR; Const argv : array of PtrUInt) : pNamedObject; begin AllocNamedObject := AllocNamedObjectA(name,@argv); @@ -453,6 +493,7 @@ FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGI begin Strnicmp := Strnicmp(PChar(RawbyteString(string1)),PChar(RawbyteString(string2)),length); end; +{$endif} function TAG_(value: pointer): PtrUInt; inline; begin diff --git a/packages/amunits/src/utilunits/hisoft.pas b/packages/amunits/src/utilunits/hisoft.pas index 2f344a9782..dbcc9e8de1 100644 --- a/packages/amunits/src/utilunits/hisoft.pas +++ b/packages/amunits/src/utilunits/hisoft.pas @@ -88,10 +88,13 @@ function FExpandLock( l : BPTR): String; var buffer : array[0..255] of char; begin + {$if not defined(AMIGA_V1_2_ONLY)} if l <> 0 then begin if NameFromLock(l,buffer,255) then FExpandLock := strpas(buffer) else FExpandLock := ''; - end else FExpandLock := ''; + end else + {$endif} + FExpandLock := ''; end; Function CSCPAR(rk : pRemember; s : String) : STRPTR; diff --git a/packages/amunits/src/utilunits/wbargs.pas b/packages/amunits/src/utilunits/wbargs.pas index e2ff3ad78f..10cba2e012 100644 --- a/packages/amunits/src/utilunits/wbargs.pas +++ b/packages/amunits/src/utilunits/wbargs.pas @@ -59,9 +59,12 @@ begin if WBMsg <> nil then begin ProgramName := strpas(WBMsg^.sm_ArgList^[1].wa_Name); end else begin + {$if not defined(AMIGA_V1_2_ONLY)} if GetprogramName(buffer,255) then begin ProgramName := strpas(buffer); - end else begin + end else + {$endif} + begin ProgramName := ''; end; end; diff --git a/packages/fcl-process/src/amicommon/pipes.inc b/packages/fcl-process/src/amicommon/pipes.inc index da8de7ec51..53f6e5e515 100644 --- a/packages/fcl-process/src/amicommon/pipes.inc +++ b/packages/fcl-process/src/amicommon/pipes.inc @@ -31,8 +31,10 @@ var fib: TFileInfoBlock; begin Result := 0; + {$if not defined(AMIGA_V1_2_ONLY)} if Boolean(ExamineFH(BPTR(Handle), @fib)) then Result := fib.fib_size; + {$endif} end; function TInputPipeStream.GetPosition: Int64; @@ -50,11 +52,13 @@ var Filename: array[0..255] of Char; DeleteIt: Boolean; begin + {$if not defined(AMIGA_V1_2_ONLY)} if (FHandle <> UnusedHandle) and (FHandle <> 0) then begin DeleteIt := NameFromFH(BPTR(FHandle), @(Filename[0]), 255); FileClose(FHandle); if DeleteIt then AmigaDos.dosDeleteFile(@(Filename[0])); - end; + end; + {$endif} end; diff --git a/packages/rtl-console/src/amicommon/crt.pp b/packages/rtl-console/src/amicommon/crt.pp index f2b90a7d4f..2373c7f4d8 100644 --- a/packages/rtl-console/src/amicommon/crt.pp +++ b/packages/rtl-console/src/amicommon/crt.pp @@ -556,8 +556,10 @@ begin else InternalWrite(CSI + '22;3'+ IntToStr(AnsiColors[Color].o) + 'm') {$else} + {$if not defined(AMIGA_V1_2_ONLY)} if Pens[Color] < 0 then Pens[Color] := ObtainBestPen(IntuitionBase^.ActiveScreen^.ViewPort.ColorMap, AnsiColors[color].r shl 24, AnsiColors[color].g shl 24, AnsiColors[color].b shl 24, [TAG_END]); + {$endif} TheUnit := GetConUnit; if Assigned(TheUnit) then begin @@ -595,8 +597,10 @@ begin else InternalWrite(CSI + '22;4'+ IntToStr(AnsiColors[Color].o) + 'm') {$else} + {$if not defined(AMIGA_V1_2_ONLY)} if Pens[Color] < 0 then Pens[Color] := ObtainBestPen(IntuitionBase^.ActiveScreen^.ViewPort.ColorMap, AnsiColors[color].r shl 24, AnsiColors[color].g shl 24, AnsiColors[color].b shl 24, [TAG_END]); + {$endif} TheUnit := GetConUnit; if Assigned(TheUnit) then begin @@ -891,7 +895,9 @@ procedure InitCRT; var i: Integer; begin + {$if not defined(AMIGA_V1_2_ONLY)} SetMode(DosOutput(), 1); + {$endif} // AssignCrt(Output); Rewrite(Output); @@ -913,11 +919,15 @@ procedure FreeCRT; var i: Integer; begin + {$if not defined(AMIGA_V1_2_ONLY)} SetMode(DosOutput(), 0); + {$endif} for i := 0 to High(Pens) do begin + {$if not defined(AMIGA_V1_2_ONLY)} if Pens[i] >= 0 then ReleasePen(IntuitionBase^.ActiveScreen^.ViewPort.ColorMap, Pens[i]); + {$endif} Pens[i] := -1; end; // reset colors and delete to end of screen (get rid of old drawings behind the last caret position) diff --git a/packages/rtl-console/src/amicommon/keyboard.pp b/packages/rtl-console/src/amicommon/keyboard.pp index d6c1c4c6e8..eebcd1202e 100644 --- a/packages/rtl-console/src/amicommon/keyboard.pp +++ b/packages/rtl-console/src/amicommon/keyboard.pp @@ -22,7 +22,7 @@ interface message port of the window. This is mainly used in Free Vision to give up the Task''s timeslice instead of dos.library/Delay() which blocks the event handling and ruins proper window refreshing among - others + others input: specify a timeout to wait for an event to arrive. this is the maximum timeout. the function might return earlier or even immediately if there's an event. it's specified in milliseconds @@ -31,6 +31,10 @@ interface function WaitForSystemEvent(millisec: Integer): boolean; +function IBMToANSI(s: RawByteString): RawByteString; +function ANSIToIBM(s: RawByteString): RawByteString; + + implementation uses @@ -69,7 +73,7 @@ end; var KeyQueue: TKeyEvent; -type +type RawCodeEntry = record rc,n,s,c,a : Word; { raw code, normal, shift, ctrl, alt } end; @@ -90,7 +94,7 @@ const (rc: 77; n: $5000; s: $5000; c: $9100; a: $A000; ), // DOWN // shift? (rc: 78; n: $4D00; s: $4D00; c: $7400; a: $9D00; ), // RIGHT // shift? (rc: 79; n: $4B00; s: $4B00; c: $7300; a: $9B00; ), // LEFT // shift? - + (rc: 80; n: $3B00; s: $5400; c: $5E00; a: $6800; ), // F1 (rc: 81; n: $3C00; s: $5500; c: $5F00; a: $6900; ), // F2 (rc: 82; n: $3D00; s: $5600; c: $6000; a: $6A00; ), // F3 @@ -175,6 +179,118 @@ begin LastShiftState := LastShiftState or $40; end; +procedure AnsiToIBMChar(var c: Char); inline; +begin + // https://en.wikipedia.org/wiki/Code_page_437 + case c of + // line 8 + #$C7: c := #128; // C + #$FC: c := #129; // ue + #$E9: c := #130; // e' + #$E2: c := #131; // a^ + #$E4: c := #132; // ae + #$E0: c := #133; // a` + #$E5: c := #134; // a° + #$e7: c := #135; // c + #$ea: c := #136; // e^ + #$eb: c := #137; // ee + #$E8: c := #138; // e` + #$ef: c := #139; // ie + #$ee: c := #140; // i^ + #$ec: c := #141; // i` + #$C4: c := #142; // AE + // line 9 + #$C9: c := #144; // Ee + #$e6: c := #145; // a-e + #$c6: c := #146; // A-E + #$F4: c := #147; // o^ + #$F6: c := #148; // oe + #$F2: c := #149; // o` + #$FB: c := #150; // u^ + #$F9: c := #151; // u` + #$FF: c := #152; // ye + #$D6: c := #153; // OE + #$DC: c := #154; // UE + #$A2: c := #155; // cent + #$A3: c := #156; // Pound + #$A5: c := #157; // Yen + // line A + #$E1: c := #160; // a' + #$ED: c := #161; // i' + #$F3: c := #162; // o' + #$FA: c := #163; // u' + #$F1: c := #164; // n~ + #$D1: c := #165; // N~ + // line E + #$DF: c := #225; // sz + + end; +end; + +procedure IBMToAnsiChar(var c: Char); inline; +begin + case c of + // line 8 + #128: c := #$C7; // C + #129: c := #$FC; // ue + #130: c := #$E9; // e' + #131: c := #$E2; // a^ + #132: c := #$E4; // ae + #133: c := #$E0; // a` + #134: c := #$E5; // a° + #135: c := #$e7; // c + #136: c := #$ea; // e^ + #137: c := #$eb; // ee + #138: c := #$E8; // e` + #139: c := #$ef; // ie + #140: c := #$ee; // i^ + #141: c := #$ec; // i` + #142: c := #$C4; // AE + // line 9 + #144: c := #$C9; // Ee + #145: c := #$e6; // a-e + #146: c := #$c6; // A-E + #147: c := #$F4; // o^ + #148: c := #$F6; // oe + #149: c := #$F2; // o` + #150: c := #$FB; // u^ + #151: c := #$F9; // u` + #152: c := #$FF; // ye + #153: c := #$D6; // OE + #154: c := #$DC; // UE + #155: c := #$A2; // cent + #156: c := #$A3; // Pound + #157: c := #$A5; // Yen + // line A + #160: c := #$E1; // a' + #161: c := #$ED; // i' + #162: c := #$F3; // o' + #163: c := #$FA; // u' + #164: c := #$F1; // n~ + #165: c := #$D1; // N~ + // line E + #225: c := #$DF; // sz + end; +end; + +function IBMToANSI(s: RawByteString): RawByteString; +var + i: Integer; +begin + for i := 1 to Length(s) do + IBMToAnsiChar(s[i]); + IBMToANSI := s; +end; + +function ANSIToIBM(s: RawByteString): RawByteString; +var + i: Integer; +begin + for i := 1 to Length(s) do + AnsiToIBMChar(s[i]); + ANSIToIBM := s; +end; + function SysPollKeyEvent: TKeyEvent; var MouseEvent: Boolean; // got a mouseevent -> do not leave cycle @@ -233,7 +349,7 @@ begin GotActiveWindow; end; IDCMP_INACTIVEWINDOW: begin - // force cursor off. we stop getting IntuiTicks when + // force cursor off. we stop getting IntuiTicks when // the window is inactive, so the blinking stops. ToggleCursor(true); GotInactiveWindow; @@ -344,6 +460,7 @@ begin ie.ie_position.ie_addr := PPointer(IAddr)^; Buff[0] := #0; Ret := MapRawKey(@ie, @Buff[0], 1, nil); + AnsiToIBMChar(Buff[0]); KeyCode := Ord(Buff[0]); KeySet^.KeyCode := Ord(Buff[0]); // if maprawkey does not work it still is 0 KeySet^.ShiftState := LastShiftState; // shift state set before the case @@ -492,7 +609,7 @@ begin Res := SysPollKeyEvent; // remove event from KeyQueue, because we return it here, // else we get double keys if GetKeyevent is called without a PollKeyEvent called first - KeyQueue := 0; + KeyQueue := 0; until Res <> 0; end else begin @@ -562,7 +679,7 @@ begin if (recvbits and windowbit) > 0 then WaitForSystemEvent:=true; - if waitTimerFired then + if waitTimerFired then begin AbortIO(PIORequest(waitTimer)); WaitIO(PIORequest(waitTimer)); @@ -575,7 +692,7 @@ procedure DoneSystemEventWait; begin if assigned(waitTimer) then begin - if waitTimerFired then + if waitTimerFired then begin AbortIO(PIORequest(waitTimer)); WaitIO(PIORequest(waitTimer)); diff --git a/packages/rtl-console/src/amicommon/video.pp b/packages/rtl-console/src/amicommon/video.pp index f591bb5690..8f1ba7c493 100644 --- a/packages/rtl-console/src/amicommon/video.pp +++ b/packages/rtl-console/src/amicommon/video.pp @@ -129,6 +129,9 @@ begin SA_Draggable , 1, SA_Quiet , 1, SA_LikeWorkbench , 1, // Let OS + {$if defined(AMIGA_V1_2_ONLY)} + SA_Depth , 4, + {$endif} TAG_END, TAG_END ]); {$ifdef VIDEODEBUG} @@ -174,9 +177,10 @@ var videoDefaultFlags: PtrUInt; begin videoDefaultFlags:=VIDEO_WFLG_DEFAULTS; + {$if not defined(AMIGA_V1_2_ONLY)} if GetVar('FPC_VIDEO_SIMPLEREFRESH',@envBuf,sizeof(envBuf),0) > -1 then videoDefaultFlags:=videoDefaultFlags and not WFLG_SMART_REFRESH; - + {$endif} if FPC_VIDEO_FULLSCREEN then begin OS_Screen := GetScreen; @@ -196,7 +200,7 @@ begin WA_Activate , 1, WA_Borderless , 1, WA_BackDrop , 1, - WA_FLAGS , VIDEO_WFLG_DEFAULTS, + WA_FLAGS , VIDEO_WFLG_DEFAULTS or WFLG_BORDERLESS, WA_IDCMP , VIDEO_IDCMP_DEFAULTS, TAG_END, TAG_END ]); @@ -266,6 +270,11 @@ begin { FIXME/TODO: next to the hardwired selection, there could be some heuristics, which sets the font size correctly on screens according to the aspect ratio. (KB) } + {$if defined(AMIGA_V1_2_ONLY)} + VideoFont:=@vgafont8; + VideoFontHeight:=8; + FPC_VIDEO_FULLSCREEN := True; + {$else} VideoFont:=@vgafont; VideoFontHeight:=16; if GetVar('FPC_VIDEO_BUILTINFONT',@envBuf,sizeof(envBuf),0) > -1 then @@ -283,6 +292,7 @@ begin end; end; end; + {$endif} // fill videobuf and oldvideobuf with different bytes, to allow proper first draw FillDword(VideoBuf^, VideoBufSize div 4, $1234D3AD); @@ -305,7 +315,7 @@ begin // borders or titlebar as intended. ScreenWidth := VideoWindow^.GZZWidth div 8; ScreenHeight := VideoWindow^.GZZHeight div VideoFontHeight; - ScreenColor := False; + ScreenColor := True; {$ifdef VIDEODEBUG} Writeln('DEBUG: Fullscreen - windowed - Width * Heigth = ',ScreenWidth,' * ',ScreenHeight); @@ -326,8 +336,13 @@ begin for Counter := 0 to 15 do begin - VideoPens[Counter] := ObtainBestPenA(VideoColorMap, + {$if defined(AMIGA_V1_2_ONLY)} + VideoPens[Counter] := Counter; + SetRGB4(@(PScreen(VideoWindow^.WScreen)^.ViewPort), Counter, vgacolors[counter, 0] shr 4, vgacolors[counter, 1] shr 4, vgacolors[counter, 2] shr 4); + {$else} + VideoPens[Counter] := ObtainBestPenA(VideoColorMap, vgacolors[counter, 0] shl 24, vgacolors[counter, 1] shl 24, vgacolors[counter, 2] shl 24, nil); + {$endif} {$ifdef VIDEODEBUG} If VideoPens[Counter] = -1 then WriteLn('errr color[',Counter,'] = ', VideoPens[Counter]) @@ -437,8 +452,10 @@ begin FreeBitmap(BufRp^.Bitmap); BufRp^.Bitmap := nil; {$endif} + {$if not defined(AMIGA_V1_2_ONLY)} for Counter := 0 to 15 do ReleasePen(VideoColorMap, VideoPens[Counter]); + {$endif} if ((FPC_VIDEO_FULLSCREEN) and (OS_Screen <> nil)) then begin CloseScreen(OS_Screen); @@ -821,7 +838,11 @@ end; function SysGetVideoModeCount: Word; begin + {$if defined(AMIGA_V1_2_ONLY)} + SysGetVideoModeCount := 1; + {$else} SysGetVideoModeCount := 2; + {$endif} end; function SysGetVideoModeData(Index: Word; var Mode: TVideoMode): Boolean; @@ -832,8 +853,9 @@ begin 0: begin Mode.Col := 80; Mode.Row := 25; - Mode.Color := True; + Mode.Color := False; end; + {$if not defined(AMIGA_V1_2_ONLY)} 1: begin Screen := LockPubScreen('Workbench'); Mode.Col := Screen^.Width div 8; @@ -841,6 +863,7 @@ begin UnlockPubScreen('Workbench', Screen); Mode.Color := False; end; + {$endif} end; SysGetVideoModeData := True; end;