News:

Welcome to RetroCoders Community

Main Menu

Recent posts

#1
Beginners / Re: C programming exercises
Last post by ron77 - Today at 04:03 PM
another two exercises in C regarding dynamic strings

first exercise:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

// 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 = 2000mb of memory
// 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0
// 1200mb in use
// 800mb free
// but as a single block you can only allocate 400mb
// and  you can reallocate the last 400mb to 500mb because there isnt 500mb free elsewhere
// but you can reallocate the the first block of 300mb up to 700mb!
// and you can reallocate the second block of 300mb up to 500mb (because they dont need to move around)


// you have 2gb of address space
// and you have a block that 1gb of sizeof
// if you try to reallocate this to 1.5gb it will fail
// because the "realloc" must first allocate the new space (1.5gb+1gb)
// then copy from the old space to the new space
// then free the old space

#include <windows.h>

int main() {
	
	SetPriorityClass( GetCurrentProcess() , REALTIME_PRIORITY_CLASS );
	
	char Buffer[4096];
	char *FullText = NULL;
	int FullTextLen = 0;
	
	while (1) {		
		printf("Type a sentence: ");
		gets(Buffer);
		
		int len = strlen(Buffer);		
		
		char* NewPtr = realloc( FullText , sizeof(char)*(FullTextLen+len+1) );
		if (!NewPtr) {
			puts("Failed to reallocate!!!!");
		} else {
			FullText = NewPtr;
		}
		
		DWORD dwStart = GetTickCount();
		for( int N = 0 ; N < 1000000 ; N++ ) { strcpy( FullText+FullTextLen , Buffer ); }
		printf("(strcpy Took %ims\n", GetTickCount()-dwStart);
		
		dwStart = GetTickCount();
		for( int N = 0 ; N < 1000000 ; N++ ) { memcpy( FullText+FullTextLen , Buffer , len+1 ); }
		printf("memcpy Took %ims\n", GetTickCount()-dwStart);
		
		#if 0
			strcpy( FullText+FullTextLen , Buffer );
			FullTextLen += len;
		#else
			memcpy( FullText+FullTextLen , Buffer , len+1 ); //+1 to copy the terminator
			FullTextLen += len;
			//FullText[FullTextLen]=0 (if copying is not an option then manually setting the terminator)
		#endif
		
		printf("%p = (%i)'%s'\n",FullText, FullTextLen, FullText);
	}
	
	return 0;
}

2nd exercise - dynamic string structure and functions (string lib)

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdbool.h>

typedef struct string {
	char* data;
	int len;
} string;

// s    - string container pointer, if passed as NULL then we allocate the container
// text - the text that will be initialized on our string container
// len  - the length of the text pointed by 'text' if -1 assume it's a C string and we must use strlen() to grab the actual length 
//        if the length is NOT -1 we can't assume that the string ends with a \0 terminator.

// returns the string* if success or return NULL if failed (if a string* is passed (not NULL) then the return value will be that same string* pointer)
// if the function fails allocating the memory for the text, but it allocated the header for the string* then it must return NULL, but it must free that allocated header

string* strInit( string* s , char* text , int len ) {
	bool allocheader = false;
	// handling the header
	if (s == NULL) { 
		s = malloc(sizeof(*s));
		allocheader = true;
		if (!s) {
			return NULL;
		}
	}
	
	// if len parameter is -1 (smaller then 0)
	if (len < 0) {
		len = strlen(text);
	}
	
	// this allocates space for the text and clean up if fails
	s->data = malloc(len + 1);
	if (!s->data) {
		if (allocheader) {
			free(s);
		}
		return NULL;
	}
	
	//this copy the data from char to the string
	memcpy(s->data, text, len);
	s->data[len] = 0;  // this setup the 0 terminator at the end of the string
	
	s->len = len;  // set up the string length to the length of the char array
	
	return s;
	
	/*  // my first try - crash and burned!!!
		if (string != NULL) {
			return string*;
		}
		if (len == -1) {
			
		int stringLen = strlen(text);
		char* stringPtr = realloc(text, sizeof(char)*stringLen+1);
		s.data = stringPtr
		s.Len = stringLen
		return s
	*/
	

}

// simplification that always allocates the header and always calculates the size from the immediate text (should be freed with strDelete);
#define strNew( _text ) strInit( NULL , _text , -1 );

// s - string container to clean up

// free the s->data memory and zero the contents of the header(container)
void strClean( string* s ) {
	if (!s) {
		return ;
	}
	if (s->data) {
		free(s->data);
	}
	memset(s, 0, sizeof(*s));
}

// s - string container to cleanup AND free the container

// calls the strCLean to cleanup the string, and then use free to deallocate the header(container) 
void strDelete( string* s) {
	if (!s) {
		return ;
	}
	strClean(s);
	free(s);
}

int main() {
	
	string MyString;	
	strInit( &MyString , "Hello" , - 1);
	
	/*
	char Buffer[4096];
	char *FullText = NULL;
	int FullTextLen = 0;
	
	printf("Type a sentence: ");
	gets(Buffer);
	*/
	
	printf( "Before Clean = '%s'\n" , MyString.data );
	strClean( &MyString );
	printf( "After Clean = '%s'\n" , MyString.data );
	
	
	string *MyName = strNew( "Greg" );
	puts( MyName->data );
	strDelete( MyName );
	
	
	return 0;
}
#2
Oxygen Basic / Re: AurelEdit v0.7
Last post by aurel - Today at 11:07 AM
Because i have one toolbar button unused i have in plan to
add whole micro(A) package into Aurel Edit distribution.
#3
Micro(A) Interpreter / Re: No ESC key loop
Last post by aurel - Today at 08:43 AM
Same case as above program is in Transformer Calculator
so here is updated Transformer Calc with "No ESC loop"

'Transformer Calculator in micro(A) by Aurel,(c)AurelSoft
var mx, my, wp, pvolt, pturns, svolt, sturns, tpv ,trlen
ptr wmKeyDown
var leftkey, rightkey ,upkey, downkey
tpv = 1 : trlen = 200
wcolor 40,60,120 fcolor 140,180,200
print 5,310,"PRIMARY(turns)" : print 5,350,"VOLTAGE  ( V )"
print 300,312,"SECONDARY(turns)" : print 300,350,"VOLTAGE  ( V )" : print 250,400,"TURNS PER VOLTAGE (T)"

fcolor 220,180,150 : print 5,290,"Transformer Calculator micro(A)"
DisplayUpdate()
Info()
DrawTrafo()

label restart

WinMsg wmKEYDOWN

hWparam wp
'vkLEFT ? primary(-)
if wp = 37
   pvolt = pvolt - 1  : pturns = pvolt * tpv
   DisplayUpdate() 
endif

'vkRIGHT ? primary(+)
if wp = 39
    pvolt = pvolt + 1  : pturns = pvolt * tpv
    DisplayUpdate() 
endif

'vkUP ? secondary(+)
if wp = 38
    svolt = svolt + 1  : sturns = svolt * tpv
    DisplayUpdate() 
endif

'vkDOWN secondary(-)
if wp = 40
    svolt = svolt - 1  : sturns = svolt * tpv
    DisplayUpdate() 
endif

'vk PAGE UP turns per voltage (+)
if wp = 33
   tpv = tpv + 1 : pturns = pvolt * tpv : sturns = svolt * tpv : DisplayUpdate()
endif

'vk PAGE DOWN turns per voltage (-)
if wp = 34
   tpv = tpv - 1 : pturns = pvolt * tpv : sturns = svolt * tpv : DisplayUpdate() 
endif

if wp = 27 : goto restart : endif

While wp ! 27 
 hwparam wp
 DisplayUpdate()
 
Wend

EndWm


func DisplayUpdate() 
   'primary
   fcolor 90,90,90 :rect 130,310,120,24   
   fcolor 100,160,220 : print 150,315,pturns
   fcolor 190,90,90 :rect 130,345,120,24   
   fcolor 100,160,220 : print 150,350,pvolt
   'secondary
   fcolor 90,90,90 :rect 430,310,120,24   
   fcolor 100,160,220 : print 450,315,sturns
   fcolor 190,90,90 :rect 430,345,120,24   
   fcolor 100,160,220 : print 450,350,svolt
   'turns per voltage
   fcolor 90,90,90 :rect 430,400,120,24   
   fcolor 100,160,220 : print 450,405,tpv
swap
endfn

func Info()
   fcolor 140,180,200
   print 20,410,"LEFT primary......-1 V"
   print 20,430,"RIGHT primary.....+1 V"
   print 20,450,"UP secondary......+1 V"
   print 20,470,"DOWN secondary....-1 V" 
   print 20,490,"PAGE_UP    TPV....+1 N"
   print 20,510,"PAGE_DOWN  TPV....-1 N"
endfn

func DrawTrafo()
   'dispay frame 
   fcolor 90,90,90 :rect 4,4,612,250
   'trafo frame
   fcolor 190,190,190 :rect 200,40,trlen,180 : trlen = trlen - 40
   fcolor 190,190,190 :rect 220,60,trlen,140
   'draw primary coil
    fcolor 210,110,110 :rect 180,70,50,4
    var ty : ty = 75
	while ty < 190
         fcolor 210,110,110 :rect 180,ty,50,4
         ty = ty + 5
     wend
    'draw secondary coil
    fcolor 210,110,110 :rect 370,70,50,4
    ty = 75
	while ty < 190
         fcolor 210,210,110 :rect 370,ty,50,4
         ty = ty + 5
     wend
swap
endfn
 
#4
Micro(A) Interpreter / No ESC key loop
Last post by aurel - Today at 08:27 AM
This is updated Dipol Calc program which show
how to prevent program execution by pressing key ESC (vk_27)

'Antenna Dipol Calculator demo
var mx, my, wp, cons, freq, length ,dlen, ox, cx, dx
ptr wmKeyDown
var mode
cons = 142.5 : freq = 10 : length = cons/freq : ox = 400 : dx = ox - length/10 : cx = 400
wcolor 40,60,120 : fcolor 140,180,200 : ' rect 0,0,800,600 
print 6,10,"FREQENCY(MHz)"
print 6,40,"LENGTH  ( m )"
fcolor 220,180,150 : print 300,10,"Antenna Dipol Calculator micro(A)-DEMO":swap
mode = 1  ' 1 to 10 Mhz
dlen = int(length*3.14) :   dx = ox - (dlen/2) 
print 300,24,dx :  fcolor 100,140,100 : print 300,44,(1.41*5)
DisplayUpdate()
Info()
DrawDipol()
swap

label restart

WinMsg wmKEYDOWN

hWparam wp
'vkLEFT ?
if wp = 37
   if freq > 1
   freq = freq - 1 : length = cons/freq : dlen = int(length*5)
        if dx > 0 
           dx = ox - (dlen/2)
           DisplayUpdate() : DrawDipol()
        endif
   endif
endif

'vkRIGHT ?
if wp = 39
    if freq < 2500
    freq = freq + 1 : length = cons/freq : dlen = int(length*5)
       if dx < 400 
          dx = ox - (dlen/2) 
          DisplayUpdate() : DrawDipol()
       endif
    endif
endif

'if ESC pressed restart wp and prevent blocking arrow keys
if wp = 27 : goto restart : endif

'no ESC loop
while wp ! 27
hwparam wp
DisplayUpdate()
DrawDipol()
swap
wend

EndWm

func DisplayUpdate()
   fcolor 90,90,90 :rect 124,5,100,24   
   fcolor 100,160,220 : print 130,10,freq 
   fcolor 90,90,90 :rect 124,35,100,24   
   fcolor 100,160,220 : print 130,40,length
   'swap
endfn

func Info()
   fcolor 140,180,200
   print 20,410,"LEFT Key... <--  -1 MHz"
   print 20,430,"RIGHT Key.. -->  +1 Mhz"
   print 20,450,"UP Key... <--   +10 MHz"
   print 20,470,"DOWN Key... <-- -10 MHz" 
  ' swap
endfn

func DrawDipol()
   'draw frame 
   fcolor 90,90,90 :rect 0,180,800,60
   'draw dipol
   fcolor 190,90,90 :rect dx,200,dlen,20
   'draw connector
   fcolor 200,200,100 : circle cx,220,6 
swap
endfn
#5
FreeBasic Tips & Tricks / Re: Color function
Last post by aurel - Today at 06:19 AM
WOW..
hi mysoft
well Norby Droid made it as a Return Val ("&H"+"9999FF") <-- string
and i don't know why..

wow static global unsigned long type array created in sequences as list.

ufff ..did i explain it properly?  :D
#7
C / C++ / Re: SectorC
Last post by mysoft - May 31, 2023, 06:44 PM
very cool, despite the limitations, but then again it's 510 bytes :) but yeah 16bit asm is unbeliveable awesome for that
#8
Oxygen Basic / Re: AurelEdit v0.7
Last post by aurel - May 31, 2023, 06:15 PM
You can download v0.7
from :

https://sourceforge.net/projects/aureledit-ide/files/

Aurel Edit comes with gxo2 compiler
Version 0.7 comes with examples
Switching between open tabs track your cursor position.
#9
FreeBasic Tips & Tricks / Re: Color function
Last post by mysoft - May 31, 2023, 05:06 PM
hu why that color function uses a huge select case, instead of being a simple static array?

static shared as ulong stColour(...) = {
  _''Black     Blue       Green      Cyan        Red      Magenta    Brown    Light Gray 
  &h000000 , &h0000AA , &h00AA00 , &h00AAAA , &hAA0000 , &hAA00AA , &hAA5500 , &hAAAAAA , _ '' 0 to  7
  _''Dk Gray  Lt Blue   Lt Green   Lt Cyan     Lt Red      Pink      Yellow      White      
  &h555555 , &h5555FF , &h55FF55 , &h55FFFF , &hFF5555 , &hFF55FF , &hFFFF55 , &hFFFFFF , _ '' 8 to 15
  _''LCARS Colours
  &hCCCCFF , &hFF3300 , &h993300 , &hFF9900 , &hCC99CC , &hCC6666 , &h99CCFF , &h6666FF , _ ''16 to 23
  &h6699CC , &h9966FF , &hFF9966 , &hCC6699 , &h9999FF , &hCC9966 , &hCCCC66 , &h999933 _   ''24 to 31
}
#10
Other Programming Languages / Tiny RichEdit E2 code editor
Last post by aurel - May 31, 2023, 12:33 PM
..written in o2 with richedit control
also have primitive syntax coloring
/* *************************************************** 
** micro(A) edito( microE2)/ o2 v043 - 26.8.2020 by Aurel   **
******************************************************
*/
$ Filename "microE2.exe" 
Include "RTL32.inc"
Include "awinh037.inc"
#lookahead

'api calls for subclasing + some GDI functions(! you can put it inside include file)
! CallWindowProc Lib "user32.dll" Alias "CallWindowProcA"(sys pPrevWndFunc ,hWnd ,uMsg ,wParam ,lParam ) as int
! GetDlgItem Lib "user32.dll" Alias "GetDlgItem" (ByVal hDlg As INT, ByVal nIDDlgItem As INT) As INT
! GetTextMetrics Lib "gdi32.dll" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
'! DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
! GetCaretPos Lib "user32.dll" Alias "GetCaretPos"(lpPoint AS POINTAPI) as INT
! wsprintf Lib "user32.dll" Alias "wsprintfA" (ByVal lpzBuffer as sys, ByVal lpzFormat As String, Byval Number as int) As int

! SaveDC Lib "gdi32.dll" (ByVal hdc As int) As int
! RestoreDC Lib "gdi32.dll" (ByVal hdc As int, ByVal nSavedDC As int) As sys
! CreateRectRgn Lib "gdi32.dll" (ByVal X1 As int, ByVal Y1 As int, ByVal X2 As int, ByVal Y2 As int) As int
! SelectClipRgn Lib "gdi32.dll" (ByVal hdc As int, ByVal hRgn As int) As int
'use corewin 
! GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hctl As int, ByVal nIndex As int) As int
! SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hctl As int, ByVal nIndex As int, byval dwNewLong As int) As int
! GetSystemMenu Lib "user32.dll" (ByVal hwnd As Int, ByVal revert As Int) As Int
! EnableMenuItem Lib "user32.dll" (ByVal menu As Int, ByVal IDeEnableItem As Int, ByVal enable As Int) As Int
'declare function GetWindowLongPtr Lib "user32.dll" Alias "GetWindowLongPtrA"(ByVal hctl As Long, ByVal gwlData As Long) As int
'declare function SetWindowLongPtr Lib "user32.dll" Alias "SetWindowLongPtrA" (ByVal hctl As long, ByVal nIndex As Long, dwNewLong As sys) As int
! BitBlt Lib "gdi32.dll" (ByVal hDestDC As int, ByVal x As int, ByVal y As int, ByVal nWidth As int, ByVal nHeight As int, ByVal hSrcDC As int, ByVal xSrc As int, ByVal ySrc As int, ByVal dwRop As int) As int
'Declare Sub Colorize(byval line_num as Int)
'+% EM_GETTEXTLENGTHEX = 1119 
% RTGETTEXTLENGTH = 18
% CFM_BOLD = 0x00000001 
% CFM_COLOR = 0x40000000 
% SCF_SELECTION = 0x0001
% WM_CUT = 0x300
% WM_COPY = 0x301
% WM_PASTE = 0x302
% WM_SETREDRAW = 0xB
% PatCopy = 15728673
% GWL_WNDPROC = -4

'use corewin
'file path
char tx[500000]
string compName="\microA_Interpreter.exe"   ' for oxygen change path to \gxo2.exe
char cdPath[256]
string crlf = chr(13)+chr(10)
string tempFile
'string cdPath
GetCurrentDir 256,strptr cdPath
'GetTempPath ( 256, strptr cdPath)
cdPath = cdPath + compName
INT win 'main window
INT x=200,y=220,w=800,h=600,wstyle = WS_MINMAXSIZE
'context menu
% WM_CONTEXTMENU = 123
INT richMenu , mousex , mousey, submenu1
INT cFont=1
win = SetWindow("micro Edit: ",x,y,w,h,0,wstyle)
''load menu bitmaps...
INT mImg1 = LoadImage(0, "micData\mImg1.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "micData\mImg2.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "micData\mImg3.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "micData\mImg4.bmp", 0, 16, 16, 24)
INT mImg5 = LoadImage(0, "micData\mImg5.bmp", 0, 16, 16, 24)
'create file path box  ---------------------------------------------------------------------
int ed1ID = 99
int edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID)
'buttons init...............................................................................
'icon button -> 1409351744 , normal -> 0x50001000
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(win,10,2,48,48,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "micData\icOpen.ico", 1, 32, 32, 24) 'load icon...
SendMessage( button1, 247, 1, icon1)                        'add icon to button...
'...........................................................................................
INT button2, b2ID = 101 
button2 = SetButton(win,60,2,48,48,"", ICONBUTTON, 0,b2ID)
INT icon2 = LoadImage(0, "micData\icSave.ico", 1, 32, 32, 24)
SendMessage( button2, 247, 1, icon2) 
'...........................................................................................
INT button3, b3ID = 102 
button3 = SetButton(win,110,2,48,48,"", ICONBUTTON, 0,b3ID)
INT icon3 = LoadImage(0, "micData\icCompile.ico", 1, 32, 32, 24)
SendMessage( button3, 247, 1, icon3)   
'............................................................................................
INT button4 , b4ID = 103 
button4 = SetButton(win,160,2,48,48,"", ICONBUTTON, 0,b4ID)
INT icon4 = LoadImage(0, "micData\icRun.ico", 1, 32, 32, 24)
SendMessage( button4, 247, 1, icon4) 
'...........................................................................................
INT button5 , b5ID = 104 
button5 = SetButton(win,210,2,48,48,"", ICONBUTTON, 0,b5ID)
INT icon5 = LoadImage(0, "micData\icFont.ico", 1, 32, 32, 24)
SendMessage( button5, 247, 1, icon5) 
                     
'richedit...................................................................................
INT hRich : INT richID = 400 : INT rx = 10,ry = 54, rw = 600, rh = 480
hRich = SetRichEdit (win, rx, ry, rw, rh,"", 1412518084, 0x200, richID)
'set font & back color......................................................................
ControlFont(hRich, 14, 9, 400, "Consolas") : SetRichEditBackColor hRich, RGB( 230, 230, 230 ) 'RGB(240,234,180)rgb( 182, 207, 248 )
'create margin on richedit control...
% MARGIN_X = 64
SendMessage hRich, EM_SETMARGINS, EC_LEFTMARGIN, MARGIN_X 
INT editProc = GetWindowLong( hRich, GWL_WNDPROC)
'subclass richedit to his own callback function
SetWindowLong(hRich, GWL_WNDPROC, @editCallback)

'init context popup_menu and set client rect to richedit
RECT rcRE
RichEditPopUpMenu()
'enable menu items - MF_ENABLED = 0
EnableMenuItem ( richMenu, 700, 0)
'init keywords and selections for richedit control
CHARFORMAT cf 
% keywordCount = 30
STRING keyword[32]
InitSyntaxHighlightning()
INT mask
% ENMKEYEVENTS    = 65536
% ENMCHANGE       = 1
% EM_HIDESELECTION = 1087

'set focus to richedit control
SetFocus hRich
'let the richedit control send a message when the contents have changed
'SendMessage(hRich, RTSETEVENTMASK , mask | ENMKEYEVENTS | ENMCHANGE , 0)
SendMessage hRich, EM_SETEVENTMASK , 0, ENMCHANGE | ENMKEYEVENTS  
'(WM_USER + 38)
'SendMessage hRich, WM_SETTEXT, 0, strptr "var a"
 'SendMessage(hRich, WM_SETREDRAW, -1, 0)
INT Scanning = 0


Wait()  'message loop

'main window callback function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function WndProc (sys hwnd,wmsg,wparam,lparam) as int callback
win = hwnd
'locals
INT cLine, CurrentStartPos , CurrentEndPos

SELECT hwnd

CASE win

		SELECT wmsg

			Case WM_COMMAND
                 controlID = LoWord(wParam) 'get control ID
			   notifyCode = HiWord(wParam) 'get notification message

	                 Select controlID
    
				      CASE b1ID
                           'open file 
		                  If notifycode=0
                           doOpen() 
		                  End If 
					 CASE b2ID
                           'save file
                           If notifycode=0
                           doSave()
		                  End If 
                       CASE b3ID
                           'compile file
                           If notifycode=0
                           doCompile()
		                  End If 

                      ' CASE b4ID
                          'just run file ..not yet

                       CASE b5ID
                          'change font 1/2
                          If notifycode=0
                           if cfont =1 
                            cfont=cfont+1
                           else
                           cfont=cfont-1 
                           end if
                           doFont()
		                 End If 

           CASE richID
               If notifycode = 768 'EN_CHANGE -> the contents of the richedit are changed
                  'The following returns the index (0-based) of the line containing the current character.
                  ' SendMessage hRich, EM_HIDESELECTION, ,0 
				SendMessage hRich,EM_GETSEL, @CurrentStartPos ,0
                  cLine = SendMessage hRichEdit,EM_LINEFROMCHAR, CurrentStartPos,0
                  SendMessage hRich, EM_HIDESELECTION, 1, 0 
                      HighlightLine(cLine)

				if GetAsyncKeyState(VK_RETURN) = 1
                       HighlightLine(cLine-1)
                  end if 
				
                SendMessage hRich, EM_SETSEL,  CurrentStartPos,CurrentStartPos  ' Return cursor to its correct position.
                SendMessage hRich,EM_SETMODIFY,0,0
                SendMessage hRich, EM_HIDESELECTION, 0,0

	
               End if


                      
                      End Select
'~~~~~ select context menu items ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                
'----------------------------------------------------------------------------------------------
              Case WM_CONTEXTMENU
                  mousex = LoWord(lParam) : mousey = HiWord(lParam)  'get mouse coordinate
                   GetClientRect(hRich, rcRE)
				TrackPopupMenu (richMenu, 0, mousex, mousey, 0, hRich, rcRE )   'put context menu where mouse is
			'TrackPopupMenu (hMenu As INT, wFlags As INT, x As INT, y As INT, nReserved As INT, hwnd As INT, lprc As RECT) As INT
               	return 0

			Case WM_CLOSE
				CloseWindow(win)
				EndProgram()

              Case WM_SIZE
				GetSize(win,x,y,w,h)
				MoveWindow(hRich, 10, 54, (w-rw/2)+114, (h-56)-32 , 1)
                  MoveWindow(edit1, 10, h-26, 560, 21 , 1)            'h-30)-32 
               '+ edit1 = SetEditBox(win,10,538,560,20,"FILE PATH",0x50004000,0x200,ed1ID

             

		END SELECT
         

END SELECT

Return Default
End Function
'///////////////////////////////////////////////////////////////////////////////////////////
Sub HighlightLine(Line as int)
'locals Linetext is text buffer/ subroutine from PureBasic forum
   string LineText=space(256),inst,check : INT StartPos, EndPos, LeftPos, RightPos, a, b
 '  SendMessage (riched, EM_GETLINE, i, strptr lineText) ' get line from richedit control
  SendMessage hRich,EM_GETLINE, Line, LineText  : Linetext = LCase(LineText)
  'Get the character index's of both ends of the line.
  StartPos = SendMessage (hRich,EM_LINEINDEX, Line,0)
  EndPos = StartPos + Len(LineText)
  cf.cbSize = 60
  cf.dwMask =  CFM_BOLD | CFM_COLOR 
  cf.dwEffects = CFM_BOLD ' comment this line if you don't need bold
 'Left = StartPos
  'BasicKeywords in BLUE
  For a = 1 To 32
    LeftPos = StartPos
    ''''Read.s inst$
    inst = keyword[a] : 'print "INST_KEY:" + inst
    'Repeat >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
     Do
      'RightPos = <pureBasic->FindString(LineText, inst, LeftPos-StartPos+1) + StartPos / i use INSTR() function
       RightPos = INSTR(LeftPos-StartPos+1, LineText, inst)  + StartPos
      If RightPos = StartPos 'No occurrences found.
        'print "No occurrences found"
        LeftPos = EndPos
        Else
        ';******
        LeftPos = RightPos-1 : RightPos = RightPos + Len(inst)-1
        ';******
        ';check$=Mid(LineText,right+1,1)
        check = Mid(LineText,RightPos + 1 - StartPos,1)
           'print "CHEK:" + check ' Debug check string as blank space or cr13 or Left paren
          If check = " " or check = chr(13) or check = "("
            SendMessage hRich, EM_SETSEL, LeftPos, RightPos  'Highlight the word.
            LeftPos = RightPos
            cf.crTextColor = RGB(0,0,200)

            If LCase(inst) = "var" : cf.crTextColor = RGB(200,0,0) : end if
		   If LCase(inst) = "str" : cf.crTextColor = RGB(200,0,0) : end if
            If LCase(inst) = "ptr" : cf.crTextColor = RGB(200,0,0) : end if

            SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf
         
           SendMessage hRich, EM_SETSEL, LeftPos, LeftPos+1    'Highlight the wor/default black        
           cf.crTextColor = RGB(0,0,0)
           SendMessage hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf

           Else
            LeftPos = RightPos + 1 
             'print "YES" ';Debug "yes"
        End If
      End If
    'Until LeftPos = EndPos <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    if LeftPos = EndPos : exit do : end if
    End Do
  
  Next a

END SUB

'////////////////////////////////////////////////////////////////////////
SUB InitSyntaxHighlightning()
'init keywords and selections for richedit control
keyword[1]  = "if"
keyword[2]  = "else"
keyword[3]  = "endif"
keyword[4]  = "wcolor"
keyword[5]  = "fcolor"
keyword[6]  = "bcolor"
keyword[7]  = "pset"
keyword[8]  = "line"
keyword[9]  = "circle"
keyword[10] = "rect"
keyword[11] = "func"
keyword[12] = "endfn"
keyword[13] = "winsize"
keyword[14] = "swap"
keyword[15] = "print"
keyword[16] = "sin"
keyword[17] = "cos"
keyword[18] = "tan"
keyword[19] = "sqr"
keyword[20] = "rand"
keyword[21] = "rnd"
keyword[22] = "abs"
keyword[23] = "log"
keyword[24] = "round"
keyword[25] = "int"

keyword[26] = "goto"
keyword[27] = "while"
keyword[28] = "wend"
keyword[29] = "label"
keyword[30] = "var"
keyword[31] = "str"
keyword[32] = "ptr"

END SUB
'///////////////////////////////////////////////////////////////////////////

'-------------------------------------------------------------------------
FUNCTION setRichTextColor( BYVAL NewColor AS INT) AS INT
' setRichTextColor sets the textcolor for selected text in a Richedit control.
' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
   CHARFORMAT cf
   cf.cbSize      = sizeOf(cf)       'Length of structure -> set 60
   cf.dwMask      = CFM_COLOR        'Set mask to colors only
   cf.crTextColor = NewColor         'Set the new color value
   SendMessage(hRich, EM_SETCHARFORMAT, SCF_SELECTION, cf)
END FUNCTION                                                             

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'richedit callback function
Function editCallback(sys hwnd , uMsg, wParam , lParam ) as int callback
POINTAPI  pt
CHAR sz[16]
DWORD lc
RECT crect
INT rgn
int dret
INT hDC
int line
int charpos

     dret = CallWindowProc( editProc,hWnd, uMsg,wParam,lParam)

	
    if uMsg = WM_PAINT
        lc=SendMessage(hwnd,EM_GETLINECOUNT,0,0)
        if lc
            hDC = GetDC(hwnd)
            SaveDC(hDC)
            GetClientRect(hwnd, crect)
            rgn = CreateRectRgn(crect.left,crect.top,crect.right,crect.bottom)
            SelectClipRgn(hDC,rgn)
            BitBlt (hDC,0,0,MARGIN_X,crect.bottom, hDC,0,0,PATCOPY)
           
            line=SendMessage(hwnd,EM_GETFIRSTVISIBLELINE,0,0)
            while line <= lc
                charpos = SendMessage(hwnd,EM_LINEINDEX,line,0)
                if charpos = -1 : exit while : end if
                SendMessage(hwnd,EM_POSFROMCHAR,pt,charpos)
                if pt.y > crect.bottom : exit while : end if
                'wide char
                wsprintf(&sz,"%lu",line+1)
                TextOut(hDC,25,pt.y,sz,len(sz))
                line++
            wend
            RestoreDC(hDC,-1)
            DeleteObject(rgn)
            ReleaseDC(hwnd,hDC)
        end if  
    elseif uMsg = WM_COMMAND 
            select wparam
               case 700 : SendMessage(hwnd,WM_CUT,0,0)
               case 701 : SendMessage(hwnd,WM_COPY,0,0)
			 case 702 : SendMessage(hwnd,WM_PASTE,0,0)
			 case 703 : SendMessage(hwnd,EM_SETSEL ,0,-1)
           end select

	'elseif uMsg = WM_VSCROLL
           ' If Scanning = 1 : return  : End if   

             
              'select hiword(wparam)
              ' case EN_CHANGE
                 ' print "changed.."
                 'applyColorLine()
            'end select 
   
    
    end if
    return dret      
 
 Return CallWindowProc (editProc, hwnd, uMsg, wParam, lParam)

End Function
'-------------------------------------------------------------------------
SUB RichEditPopUpMenu()
  richMenu = CreatePopupMenu ()
'addsub menu items with ID
	AppendMenu (richMenu, 0, 700, strptr "CUT")
		SetMenuItemBitmaps(richMenu, 0 , MF_BYPOSITION , mImg1, 0) 'add menu item bitmap
	AppendMenu (richMenu, 0, 701, strptr "COPY")
		SetMenuItemBitmaps(richMenu, 1,  MF_BYPOSITION , mImg2, 0) 
	AppendMenu (richMenu, 0, 702, strptr "PASTE")
		SetMenuItemBitmaps(richMenu, 2,  MF_BYPOSITION , mImg3, 0) 
	AppendMenu (richMenu, 0, 703, strptr "SELECT_ALL")
		SetMenuItemBitmaps(richMenu, 3,  MF_BYPOSITION , mImg4, 0) 

END SUB

'-----------------------------------------------------------------------------------
Sub doOpen()

INT hsize=0,LineCount,Ln
'bstring tx="" ' use bstring for text on scintilla
string dir, filter , title ,fName
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
filter = "All files "+sep+"*.*"+sep+"micro(A) files "+sep+"*.bas"
title = "Open File... "

fName = FileDialog(dir,filter,title,0,0,"bas")
'print "FNAME:" + fName
'fileName = fName
IF LEN(fname) = 0
   MsgBox "File Opening Canceled!" , "microEdit :: INFO!"
Return
END IF

SendMessage edit1,WM_SETTEXT, 0,  strptr(fname)
'SendMessage status,WM_SETTEXT,0, byval strptr(fName)
 tx =  GetFile fName
SendMessage hRich,WM_SETTEXT, 0, strptr(tx)
tempFile = fName
'get line count...
LineCount = SendMessage hRich, EM_GETLINECOUNT, 0,0 ' get number of Lines
'MsgBox "Lines: " + str(LineCount),"m(A):Line Count->" 'comment this line without message
'Highlight each line one by one in a for/loop...

SendMessage(hRich, WM_SETREDRAW, 0, 0)
IF LineCount > 0
   For Ln = 0 to LineCount
       HighlightLine(Ln)
   Next Ln
END IF
SendMessage(hRich, WM_SETREDRAW, -1, 0)
InvalidateRect(hRich, 0, 0) : UpdateWindow hRich


End Sub
'--------------------------------------------------------------------
Sub doSave()

INT hsize=0,found,c
string dir="",filePath,filter,title,fName
string ext=".bas"

filter= "micro(A) Files (*.bas)"
title="Save File... "    'for Oxygen change to *.o2bas

fName = FileDialog(dir,filter,title,0,1,"bas")

If fName="" then Return
  IF RightS(fname,4) <> ".bas"  'for microA set number to 4 , .bas
    fname = fname + ext
  END IF
print fname
'hsize = SendMessage hRich, EM_GETTEXTLENGTHEX, 0, 0
'print "HSIZE:" + str(hsize)
SendMessage hRich,WM_GETTEXT, 4096,tx
print "TX:" + tx
'exit if empty
'IF hsize = 0
'MsgBox "Document is Empty!" ,"micro Edit"
'Return    ' ->->->
'END IF
'else -> save file

SendMessage hRich,WM_GETTEXT, 4096,tx

c=PutFile fName,tx
tempFile = fname

End Sub
'--------------------------------------------------------------
SUB doCompile
char ln[256]
string fn=""
SendMessage edit1, WM_GETTEXT, 256, strptr ln
fn = Trim(ln)
'print "doCompile-FN:" + fn

IF LEN(fn) < 1
MsgBox "File Not Open!","Error::File"
Return
End If
int sRet
autosave()  ' do autoSave 
'(sys hwnd, string lpOperation, lpFile, lpParameters, lpDirectory, sys nShowCmd) as sys
sRet = ShellExecute(0,"open", cdPath, chr(34) + fn + chr(34),"" , 5) ' if work sRet = 42
If sRet = 2 then MsgBox "Compiler microA Not Found!"+ crlf + "Enter new compiler path!" , " microA Path"
'sRet = ShellExecute 0,"open","gxo2.exe","-c "+ fn,"",5
'sRet = ShellExecute 0,"open",cdPath,cOption & chr(34) & fName & chr(34),"",5 'fb

END SUB
'--------------------------------------------------------------
SUB doFont
INT LineCount,Ln
LineCount = SendMessage hRich, EM_GETLINECOUNT, 0,0 
   if cFont=1 : ControlFont(hRich, 14, 9, 400, "Consolas")
      IF LineCount > 0 :For Ln = 0 to LineCount : HighlightLine(Ln) :Next Ln :END IF
   end if
   if cFont=2 : ControlFont(hRich, 16, 8, 400, "Consolas")
      IF LineCount > 0 :For Ln = 0 to LineCount : HighlightLine(Ln) :Next Ln :END IF
   end if
END SUB
'--------------------------------------------------------------
Sub autoSave()

SendMessage hRich,WM_GETTEXT, 4096,tx
PutFile tempFile,tx

End Sub